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abstract 

A compiler for a subset of the Automated Data Processing 
Equipment Selection Office (ADPESO) HYPO-CCBOL has been 
implemented on a microcomputer. The implementation provides 
nucleus level constructs and file options from the ANSI 
COBOL package along with the PERFORM UNTIL construct from a 
higher level to give increased structural control. The 
language was implemented through a compiler and run-time 
package executing under the CP/M operating system of an 8080 
microcomputer-based system. Both the compiler and 
interpreter can be executed in 20K bytes of main memory. A 
program consisting of 8.5K bytes of intermediate code can be 
supported on this size machine. Modification of the compiler 
and interpreter programs can be accomplished to take 
advantage of larger machines. The programs that make up the 
compiler and interpreter package require 50K bytes of disk 
storage . 



4 



TABLE 0? CONTENTS 



I. INTRODUCTION 3 

A. BACKGROUND 3 

B. OPERATING ENVIRONMENT 12 

C. GOALS AND OBJECTIVES 12 

D. PROBLEM DEFINITION 11 

II. NPS MICRO-COBOL COMPILER 13 

A. GENERAL DESCRIPTION 13 

B. SYMBOL TABLE 13 

1. Numeric Values 17 

2. Numeric Edit 17 

3. Alpha or Alphanumeric 20 

4. Alpha Edit 20 

5. Tables 22 

6. Labels 22 

7. Files 24 

8. Records 25 

C. COMPILER MODULE "PART ONE ' 27 

1. Purpose 27 

2. Control Actions 27 

3. Symbol Table Entries 31 

4. Intermediate Code Generation 32 

5. Parser Actions 33 

D. INTERFACE ACTIONS 42 

E. COMPILER MODULE "PART TWO" 43 

1. Purpose 43 



5 



2. Control Actions 44 

3. Symbol Table Entries 44 

4. Intermediate Code Generation 44 

5. Parser Actions 4? 

III. NPS MICRO-COBOL INTERPRETER 57 

A. GENERAL DESCRIPTION 57 

B. MEMORY ORGANIZATION 58 

C. INTERPRETER INTERFACE 61 

D. PSEUDO-MACHINE INSTRUCTIONS 66 

1. Format 66 

2. Arithmetic Operations 66 

3. Branching 67 

4. Moves 71 

5. Input-Output 74 

7. Special Instructions 77 

IV. SYSTEM DEBUGGING METHODS AND TOOLS 80 

A. DEBUGGING METHODOLOGY 31 

3. INTERACTIVE TOOLS 82 

C. CROSS RFFEPENCE LISTINGS 93 

D. VALIDATION TESTS S3 

V. CONCLUSIONS AND RECOMMENDATIONS 35 

APPENDIX A 37 

APPENDIX 3 136 

APPENDIX C 137 

APPENDIX D 142 

APPENDIX S 151 

APPENDIX F 153 



6 



APPENDIX G 



155 



COMPUTER LISTINGS 15? 

LIST OF REFERENCES 272 

INITIAL DISTRIBUTION 274 



7 



I 



INTRODUCTION 



A. BACKGROUND 

The NPS MICRO-COBOL Compiler/Interpreter was initially 
(1976) developed to demonstrate that it was feasible to 
implement a COBOL compiler on a micro-computer. It was known 
that the C030L language used would have to he a subset of 
ANSI COBOL because of the restriction imposed by the size of 
a micro-computer memory. A subset of ANSI COBOL, 
specifically ADPSO HYP0-C03CL, was selected as the basis for 
the implementation [3]. Additional motivation was provided 
by the DOD requirement that all computers used in a 
non-tactical environment be capable of executing COBOL. 

The previous work was directed toward five major areas: 
1.) selecting a suitable COBOL subset to operate on, 2.) 
develop the associated grammar for the language, 3.) 
determine what type of compiler to design, 4.) design and 
code the compiler, and 5.) design and code the interpreter. 
The interpreter performs the functions of a classical 
linking loader, resolving forward address references and 
establishing the run time intermediate code environment, as 
well as, executing the intermedite code. 

The establishment of a suitable language was easily 
determined since HYP0-C030L was a Department of the Navy 
approved subset of COEOL, designed to place minimal 
requirements on a system for compiler support. where 
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possible, short constructs were used in the place of longer 
ones. Where more than one reserved word served the same 
function in COBOL the shortest form was used. There is no 
optional verbage in the language, and no duplicate 
constructs perform the same function. Limits were placed on 
all statements that had a variable input format so that all 
statements had a fixed maximum length. Where possible, such 
constructs were removed completely from the language. In 
addition, user defined identifier names were limited to 
twelve characters to reduce symbol table storage 
reaui remen ts . 

Rather than include the standard levels of 
implementation for all of the modules, constructs were 
included only as required. In addition to low level 
constructs, the PERFORM UNTIL construct was included to 
allow better program structure. Further justification for 
the manner of subsetting and a highly detailed description 
of each element of the language is contained in the 
HYP0-C0B0L language specifications reference 3. For a 
comparison of EYP0-C030L constructs that are not supported 
by MICR0-CC30L see appendix 0. 

The grammar for the MICRO-COBOL language was defined as 
LALR(l). The compiler design was based on a table-driven 
parser for the LALR(l) grammar. The algorithm used to 
develope the parse tables for the compiler was developed by 
7. Lalonge [17] . 

The basic design and coding of the compiler and 
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interpreter was completed prior to the current thesis work 
by Scott Allan Craig [2]. Modification t.o the original 
thesis work was conducted by Phil Mylet [151. 

B. OPERATING ENVIRONMENT 

The NPS MICRO-COBOL compiler and interpreter are 
designed to run under the CP/M operating system on an 8060 
or Z80 based microcomputer with at least 20E bytes of main 
memory. The compiler programs are designed to use no more 
than 12K bytes of main memory, while the interpreter program 
uses approximately 8K bytes. The compiler and interpreter 
require 50K bytes of disk storage for the programs that make 
up the ccmpi ler/interpre ter package. For information on 
creating MICRO-COBOL source programs and CP/M see references 
4 and 5. 

C. GOALS AND OBJECTIVES 

The primary goal of this thesis project was to complete 
the implementation of an 8080 microcomputer based 
compiler/interpreter, which could compile and execute a 
subset of the ANSI Standard HTP0-C030L language 
specification. To achieve this goal both the compiler and 
interpreter would require testing, debugging, modification 
and implementation (extension) of any necessary additional 
language constructs. It was also decided that while testing 
and debugging, the documentation of the compiler's and 
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interpreter's internal structures, memory organization, 
interfaces and module functions would be accomplished. 

Since the amount of testing and debugging effort could 
not be accurately determined, several subgoals were 
established which would be undertaken if adequate time was 
available. These time dependent goals included the 
validation of the compiler and interpreter and the inclusion 
of additional language constructs not previously 
implemented . 

In addition to the above goals, it was considered 
beneficial to update and incorporate all previous thesis 
documentation into the present NPS MICRO-COEOL compiler and 
interpreter documentation. This documentation is appended to 
this thesis. 

D. PROBLEM DEFINITION 

For software performance assessment, a series of simple 
COBOL source programs and the Navy Automated Data Processing 
Equipment Selection Office HYPO-COBOL validation test 
programs (HCC7S) were compiled and execution was attempted. 
An evaluation of the test results indicated that the 
compiler and interpreter could only compile and execute very 
simple test programs. In particular, the compiler was unable 
to compile past the file section of the first validation 
program . 

A review of the compiler and interpreter documentation 
led to several additional conclusions. The compiler and 
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interpreter were difficult to understand, and program losic 
flow was hard to follow, because: 1.) modular functions were 
not explained well, 2.) documentation on the module 
interfacing was inadequate, 3.) complete specifications 
describing the internal structures and memory organization 
did not exist, and 4.) few comments were included within the 
source code listings. 
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II . N?S MICRO-COBOL COMPILER 



A. GENERAL DESCRIPTION 

The MICRO-COBOL compiler is a one pass compiler that 
scans and parses MICR0-C030L source programs, and generates 
intermediate code (pseudo-instructions) for the interpreter 
(pseudo-machine). The scanner design is similar to most 
other scanner implementations. The parser is an LALR(l) 
table-driven design, implemented in the PLM80 programming 
language [8]. The parse tables, as stated before, were 
generated using an algorithm developed at the University of 
Toronto [171 . 

The compiler reads the source program from a disk file, 
extracts the needed information for the symbol table and 
writes the pseudo-instructions to an intermediate code file. 
To accomplish this function, the compiler consists of three 
modules: PART CNS , I READER , and PART TWO. 

3. SYMBOL TABLE 

The symbol table is the key data structure in the 
compiler. Information concerning identifiers, files, and 
records specified in the DATA DIVISION of the MICR0-C030L 
source program is stored in the symbol table, along with 
labels specified in the PROCEDURE DIVISION. 

The symbol table structure consists of: 1.) a sixty-four 
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address hash table, 2.) a fixed length field of thirteen 
bytes for each symbol table entry, and 3.) a variable length 
field to hold the name of each identifier. Since each 
identifier name is limited to twelve ASCII characters the 
symbol table entry for identifiers can vary in length from 
thirteen to twenty-five bytes. The bytes of each symbol 
table entry are grouped into various fields of either one or 
two bytes depending on the storage requirements. The 
thirteen bytes of the fixed length field entry are numbered 
from zero to twelve and the variable length field begins 
with byte thirteen. In referencing a specific field a byte 
index with a value from zero to thirteen is utilized. 

The symbol table entry for a single identifier could 
contain up to nine different attributes of that identifier, 
although not all identifiers required the full range of 
attributes. The various fields in the symbol table contained 
different information depending on whether, for example, an 
identifier was a numeric or alphanumeric type. Four of the 
fields contained the same information for all identifiers. 
These fields were: 1.) field zero (bytes zero and one 
contained the collision link:, 2.) field one (byte two) 
contained the type of the Identifier, 3.) field two (byte 
three) contained the length of the identifier name, and 4.) 
field thirteen (byte thirteen) was the beginning of the 
ASCII character representation. It should be noted that an 
identifier of type FILLER would not have a name associated 
with it, so field two would contain a zero and field 
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thirteen would not exist. 



Entry into the symbol table is accomplished by using a 
HASH function on the ASCII character representation of the 
identifier name. This function generates an even number 
between zero and 126 . The number is used as an index into 
the hash table by specifying an offset from the base of the 
hash table. The hash table can hold sixty-four uniquely 
determined address references to identifiers. The hash table 
entry associated with each index reference heads a linked 
list of identifiers with the same HASH function value. The 
linked list structure provides for additional identifier 
storage and therefore the number of uniaue identifiers is 
not limited by the sixty-four index values generated by the 
HASH function. A zero entry in the hash table indicates that 
there is no identifier with that EASH function value. In 
tracing through the linked list of identifiers the most 
recently declared variable appears at the end of the list. 
See figure Cl I —1 1 for an example of the computation of a 
hash value. See figure [II-2] for and example of the hash 
table indexing and linking of hash values. 
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HASH VALUE COMPUTATION 



HASH Function value: 
logically and with 



sum of identifier ASCII characters 
3FH then shifted left (SHL) one bit. 



HASHBASE = 2000H 

H. F . ( A3 ) = HASHBASE + SHL(((41H + 42H ) AND 3FE),1) = 2006E 
H.F.(BA) = HASHBASE + SHL(((42H + 41H) AND 3FH),1) = 2006H 



FIGURE II-l 



HASH TABLE, SYMBOL TABLE LINKING 



HASH SYMBOL 

TABLE TA3LE 



j 


! 2128E 


j j 




i 

i 


i collision! 




j 2126H 


I link for ! 




1 

f 


! "BA” ! 




j 2124H 


j j 



2200H 



! 200SH 

21F0H i >> 

j 2006H 



! 2000H 






collision ' 
link for ! >> — 

"A3" i 

; 21F0H 



FIGURE 1 1 -2 
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1 . Numeric Values 



The symbol table entry for numeric values can 
contain up to seven attributes of the variable. These 
attributes are: 1.) identifier type, 2.) length of variable 
name 3.) beginning address of variable storage, 4.) numeric 
count (number of storage locations required by the 
identifier), 5.) level number, 6.) number of digits to the 
right of the decimal point, and 7.) the variable name. 
Figures [ 1 1—3] and [It-4] illustrate, respectively, the 
following two COBOL declarations: 

01 NUM PIC 9(9) . 

01 NUM PIC 9(6). 999 OCCUP.S 12 TIMES. 

2 . Numeric Edit 

The numeric edit symbol table entry expands on the 
numeric symbol entry and utilizes bytes eight and nine to 
hold the beginning address, in the constants area, of the 
edit field mask. This mask allowed for the insertion of the 
following characters into and output display of a numeric 
number: fixed and floating dollar signs, credit(CR) and 

debit(DB) signs, asterisk fill, *Z’ character fill, and plus 
("+") and minus (’’-’’) signs. It should be noted that an 
identifier with a numeric edit field value can not be used 
in an arithmetic statement. 
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NUMERIC SYMBOL TABLE ENTRY. 



BYTE SYMBOL TABLE VALUE 



0-1 


! collision link 
! (00 00) 


2 


i tyoe identifier 
! (10) 

i 


3 


1 

i length of identifier 
! name (03) 


4-5 


j Beginning address 
i of identifier 

! storage (04 25) 

1 _ . .. . .. .. 


6-7 


i 

j length of identifier 
! storage (09 00) 

i 


8-9 


! 

| not used 


10 


! level entry (01) 


11 


! decimal count (00) 


12 


i occurances (00) 


13-15 


■ i 

j identifier name 
! (4E 55 4D) 

! 



01 NUM PIC 9(9) . 
FIGURE 1 1-3 
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NUMERIC SYMBOL TABLE ENTRY WITH DECIMAL 
AND OCCURS CLAUSE 



BYTE 


SYMBOL TABLE VALUE 


0-1 


! collision link 
! (09 2E ) 


2 


! type identifier 
! (10) 


3 


! length, of identifier 
! name (03) 


4-5 


i beginning address 
! of identifier stor- 
! age ( 0D 25) 


6-7 


length of identifier 

! storage (09 00) 

1 


8-9 


1 

! not used 


10 


! level entry (01) 
1 


11 


1 

! decimal count (03) 


12 


! occurances (0C) 
1 


13-15 


1 

identifier name 
! (4S 55 4D ) 


01 MUM PIC 


9(6). 999 OCCURS 12 TIMES. 
FIGURE I 1-4 
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3 . Alpha or Alphanumeric 



The alpha and alphanumeric symbol table entries 
appear similarly in the symbol table except for their type 
fields. Six entries appear in the symbol table for these 
identifiers: 1.) identifier type, 2.) length of identifier 
name, 3.) beginning address of storage, 4.) number of 
storage locations required by identifier, 5.) level entry, 
and 6.) identifer name. Figure [II-5] illustrates an alpha 
symbol table entry for the following identifier declaration: 

01 ALPHA PIC A (3) . 



4 . Alpha Id it 

The alpha edit symbol table entry expands on the 
alpha and alphanumeric edit types and utilizes bytes eight 
and nine to hold the beginning address of the edit field 
mask-. These mask fields, which are stored in the constants 
area of the pseudo-machine, contain the characters necessary 
to edit an output so that, for example, slashes or blanks 
can be interspersed in the display output. 



20 



ALPHA SYM30L TABLE ENTRY 



BYTE 


SYMBOL TABLE VALUE 


0-1 


! collision linlc 
! (00 00) 

-1 - 


2 


1 -* 
! type Identifier 
! (08) 


3 


i length of identifier 

! (05) 

_ 1 


4-5 


! 

! "beginning address 
! of identifier 
' storage (16 25) 


6-7 


! length of identifier 
! storage (08 00) 


8-9 


! not used 
! 


10 


! level entry (01) 

l 


11 


1 

! not used 


12 


! not used 

i 


13-17 


i 

I identifier name 
! (41 4C 50 48 41) 


01 


ALPHA PIC A (8 ) . 
FIGURE I 1-5 
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5 . Tables 



NPS MICRO-COBOL was designed to support singly 
indexed tables. These tables are established by using an 



OCCURS clause 


wi th 


the PICTURE 


clause 


of an 


identifier. 


If 


an identifier 


is 


specified 


as 


a 


table 


the number 


of 


occurances of 


the 


table are placed 


in 


byte 


twelve of 


the 



symbol table entry for that identifier. The table identifier 
in COBOL is similar to the subscripted variable in other 
programming languages. For example, the statement, "01 NUM 
PIC 9(9) OCCURS 12 TIMES", generates the symbol table entry 
illustrated in figure [II-4] . 

6 . Labels 

Labels generate the simplest of all symbol table 
entries, only four or five attributes are associated with 
the label. The variability depends on whether the label is 
declared in the source program before or after the label is 
referenced by a CO or PERFORM statement. In the event a 
label is specified before a GC or PERFORM statement 
references it, the symbol table would contain the following 
1.) the type associated with label, 2.) the length of the 
identifier name, 3.) the address of the first intermediate 
code instruction following the appearance cf the label in 
the source program (bytes four and five), 4.) the last 
executable instruction associated with the label (bytes 
eight and nine) This would be either the last executable 
instruction encountered before another label or the end of 
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the program., and 5.) the label name. 

In the event a label Is referenced by a GO or 
PERFORM statement before the label actually appears in the 
code, the symbol table entry performs a different function 
than just indicating the beginning and ending of the 
paragraph associated with the label. The same symbol table 
fields are used, however their meanings are different. The 
type is set to the unresolved label type of (0FFH). The 
label remains unresolved until the beginning and the ending 
addresses of the associated paragraph are determined. 

If a label is referenced for the first time by a GC 
statement the symbol table is initialized with the 
following: 1.) unresolved label type (0FFH), 2.) the address 
of the GO statement (the intermediate code would be 5RN 00 
00 where the zeros indicate where the address of the label 
is to be backs tuff ed) . See section III — B for specific 
explanation of pseudo-machine instructions., 3.) the 
remainder of the label entries would be the same except no 
entry is made for the last executable instruction associated 
with the label. If an additional reference is made to the 
label by a subsequent GC statement the following action 
would occur: 1.) the current address (bytes four and five) 
would be placed in the branch address of the GO statement, 
2.) the address of this branch statement would be placed in 
bytes four and five of the symbol table entry. This 
procedure facilitates linking together all unresolved 
references to labels so that when the label are resolved the 
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correct branch address could be placed into the intermediate 
code . 

Encountering a PERFORM statement before a label is 
declared causes the following actions: l.)bytes four and 
five contain the address of the next byte of intermediate 
code following the PER intermediate code instruction, 2.)and 
bytes eight and nine contain the address of the third byte 
following the PER instruction. If a subsequent PERFORM 
statement is encounted before the label is resolved the two 
address fields in the symbol table would be copied to tne 
associated bytes following the most current PERFORM 
statement and the address of the first and third bytes 
following the PER instruction would be copied into the 
symbol table. It should be pointed out that any number of 
PERFORM and GO statements can be specified before a label is 
res olved . 

?. Files 

The symbol table entries for files are the most 
difficult to understand. The complexity of the entries is 
due to the way files and records are declared in a 
MICRO-COBOL program. The symbol table entry for a file 
consists of the following: 1.) byte two contains the type, 
2.) byte three contains the length of the file name, 3.) 
bytes four and five contain the address in the symbol table 
of the first 01 level record associated with the file, 4.) 
bytes eight and nine contain the beginning address of the 
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file control block and input/output buffer for the file, 
(this would be the actual address in the data section of the 
pseudo-machine for the beginning of the 165 bytes associated 
with the file), 5.) if the file has a key entry associated 
with it (access via RANDOM or RANDOM RELATIVE) bytes ten and 
eleven contain the symbol table address of the access key 
variable, and 6.) the rest of the entry contains the file 
name. Figure [II-6] illustrates a file entry in the symbol 
table . 

8 . Records 

This entry contains seven attributes of a record. 
Three are the same as all other entries type, name, and 
length of name. While the other four are: 1.) bytes four and 
five contain the initial storage address for the record, 2.) 
bytes six and seven contain the number of bytes of storage 
for the record, 3.) bytes eight and nine contain the symbol 
table address of the file associated with the record (this 
facilitates referencing the file when the record is 
written), and 4.) byte ten contains the level entry for the 
record . 
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FILE SYMBOL TABLE ENTRY 

SAMPLE SOURCE PROGRAM FILS DECLARATION 

INPUT-OUTPUT SECTION. 

FILE-CONTROL. 

SELECT POSTER-FIL 

ORGANIZATION RELATIVE 
ACCESS RANDOM RELATIVE NUM 
ASSIGN CS81-FI L . 



BYTE 



SYMBOL TABLE VALUE 



0-1 


_ 1 
1 

! collison link 
_ 1 


2 


! type file 

! (03) 

1 


3 


1 " 

! length of file 

! name (05) 

. 1 


4-5 


1 

! symbol table 
! address of first 
i 01 level record 
j (09 2E) 


6-7 


! not used 
_ 1 


8-9 


? 

j first address of 
! FC3 S. buffer 
! (0E 26) 


10-11 


! symbol table 
! address of key 
j (33 27) 


12 


! not used 


13-17 


| file name 

! (52 4F 53 54 45 5: 

! 5F 46 49 4C ) 

__ 1 
1 



FIGURE 1 1 -6 
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C. COMPILER MODULE ’PART ONE" 



1 . Purpose 

This first module of the compiler performs several 
functions. First, it establishes the interface between the 
compiler and: 1.) the input source file (of type ’C3L"), 2.) 
the output intermediate code file (of type "CIN"), and 3.) 
the IREADER module which reads and passes control to PART 
TWO of the compiler. Second, it scans and parses the source 
program statements up to the PROCEDURE DIVISION. Third, it 
generates output consisting of the symbol table entries 
(saved in memory) and data initialization intermediate code. 

2 . Control Actions 

3y executing the command COBOL <source program>, the 
object code for PART ONE of the compiler is loaded into 
memory starting at 100H (if necessary this can be modified 
for different machines) by the CP/M operating system. 
Execution of PART ONE loads the program name associated with 
the source program into the input file control blocx located 
at 5CE . This allows the source program name to be saved 
until actual source program compilation begins. 

Next, the control program, IREADER, is moved to high 
memory just below the BDOS (see reference 4 for an 
explanation of BDOS and other CP/M associated names). For 
example, using an INTEL Corporation 625 MDS microcomputer 
system with the CP/M operating system, the IREADER routine 
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is moved to high memory starting at 0D000H and continuing 
through 0D0FFH. This is done for two reasons: 1.) it allows 
the symbol table of the source program to begin at the next 
address following the object code for PART ONE, and 2.) 
places IREADER high enough in memory so that it is not 
destroyed by creation of the symbol table. See figures 
[II-7] and [II-81 for illustrations of the PART ONE memory 
organization before and after the I READER routine is moved. 
The purpose of the IREADER routine will be explained in the 
next section. 
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MEMORY ORGANIZATION BEFORE IREADER ROUTINE MOVED 



BDOS 



Free Area 



Ireader Routine 
Before Move 



Part 1 of Compiler 



F000H 
Top of 



D100H 
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Next , 


the interface between the 


compiler and 


the 


input 


file 


<source 


program> and 


the output 


file 


intermediate 


code file> 


is established 


. The input 


file 


control 


block 


associated 


with the source 


file is initial 


i zed 



and the input file is opened. The input file name is copied 
to the output file control block (FCB) and if there is ar 
intermediate code file already residing on the disk, it is 
erased. The output FCB is initialized and a file directory 
entry established for the new copy of the intermediate code 
file. 

Prior to beginning the scanning and parsing actions, 
the first 128 byte record of the input file is read into the 
input buffer, located at 80E (default I/C buffer for CP/M). 
The scanner is primed with the first character of the input 
program, and scanning and parsing actions continue from this 
point in PART ONE until the PROCEDURE DIVISION of the source 
program is encountered; at this time compilation is 
suspended . 

3 . Symbol Table Entries 

Entries made in the symbol table by PART ONE will 
consist of all identifiers declared in the DATA DIVISION of 
the source program. By refering to the Symbol Table Section 
above, an explanation may be obtained regarding the various 
types of symbol table entries. 
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4. I ntermed ia te Code Generation 



Pseudo-instructions are written to the intermediate 
code file for several different reasons while PART ONE is 
scanning and parsing the source program. The first 
intermediate code generated occurs when the INPUT-OUTPUT 
SECTION of a source program is nonempty. Within the FILE 
CONTROL PARAGRAPH of this section, instructions are 
generated to initialize the FCE for the file name associated 
with the SELECT statement. The name associated with the 
ASSIGN statement is placed in the FCB and is used in 
referencing the file on the disk. 

Two other instances of intermediate code generation 
occur in the WORKING STORAGE SECTION of a source program. 
Anytime a record or elementary identifier entry has an 
edited PICTURE CLAUSE, code to initialize the storage 
beginning at the address specified in the formatted mask 
attribute of the symbol table entry will be written to the 
intermediate code file. When a record or elementary 
identifier entry has an associated numeric or nonnumeric 
VALUE CLAUSE, code to initialize the storage beginning at 
the address specified in the value location attribute of the 
symbol table entry will be written to the intermediate code 
file. 

The final pseudo-instruction written to the 
intermediate code file is the SCD instruction. This occurs 
when the parser parses the word PROCEDURE in the source 
program,' control is then passed to PART TWO and compilation 
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continues . 



5 . Parser Actions 

The actions corresponding to each parse step are 
explained below. In each case, the grammar rule that is 
being applied is given, and an explanation of what program 
actions take place for that step has been included. In 
describing the actions taken for each parse step there has 
been no attempt to describe how the symbol table is 
constructed, what pseudo-instructions are generated or how 
the values are preserved on the stack. The intent of this 
section is to describe what information needs to be retained 
and at what point in the parse it can be determined. Where 
no action is required for a given statement, or where the 
only action is to save the contents of the too of the stack, 
no explanation is given. Questions regarding the actual 
manipulation of information should be resolved by consulting 
the programs. 

1 <program> : := <id-div> <e-div> <d-div> PROCEDURE 

Reading the word PROCEDURE terminates the first 
part of the compiler. 

2 <id-div> ::= IDENTIFICATION DIVISION. PROGRAM-ID. 

<comment> . <auth> <date> <sec> 

3 <auth> : AUTHOR . <comment> . 

4 i <empty> 

5 <date> ::= DATE-WRITTEN . <comment> . 

6 i <empty> 
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7 <sec> ::= SECURITY . <comment> . 

S ! <empty> 

9 <comment> : := <input> 

10 ! <comment> <input> 

11 <e-div> ::= ENVIRONMENT DIVISION . CONFIGURATION 

SECTION . 

<scr-obj> <i-o> 

12 <src-obj> ::= SOURCE-COMPUTER . <comment> <debug> . 

OBJECT-COMPUTER . <comment> . 

13 <debug> DEBUGGING MODE 

Set a scanner toggle so that debug lines will be 
read . 

14 ! <empty> 

15 <i-o> ::= INPUT-OUTPUT SECTION . FILE-CONTROL . 

<f ile-control-list> <ic> 

16 i <empty> 

17 <f ile-control-list> <f ile-cont rol-en try> 

! <f ile-control-li st> 

<file-control-entry> 

19 <f ile-control-en try> ::= SELECT <id> <attribute-list> . 

At this point all of the information about the file 
has been collected and the type of th* 3 file can be 
determined. File attributes are checked for 
compatability and entered in the symbol table. 

20 <att ribute-list> ::= <one attrib> 

21 ! <a t t r ibu te-1 i s t > <one attrib> 

22 <one-attrib> : := ORGANIZATION <org-ty?e> 
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23 


! ACCESS <acc-type> 


<rela tive> 


24 


i ASSIGN <input> 






A file control block is built for 


the file using the 




INT operator. 




25 


<or?-type> ::= SEQUENTIAL 






No information needs to be stored 


since the default 




file organization is sequential. 




26 


RELATIVE 





The relative attribute is saved for production 19. 

27 <acc-type> ::= SEQUENTIAL 

This is the default. 

28 I RANDOM 

The random access mode is saved for production 19. 

29 < relative)- ::= RELATIVE <id> 

The pointer to the identifier will he retained by 
the current symbol pointer, so this production only 
saves a flag on the value stack indicating that the 
production did occur. 

30 ! < empty > 

31 <ic> ::= I-O-CONTROL . <same-list> 

32 ! <empty> 

33 <same-list> : <same-element> 

34 ! <same-list> <same-elemen t> 

35 <same-element> : := SAME <id-string> . 

36 <id-string> : := <id> 

37 j <id-string> <id> 

38 <d-div> ::= DATA DIVISION . <f ile-sect ion> <*ork> 
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<link> 



39 <file-section> : := FILE SECTION . <flle-list> 

A flag needs to be set to indicate completion of 
the file section, so that the appropriate routine 
will be called when parsing level entries in the 
WORKING STORAGE SECTION. 

40 ! <empty> 

The flag, indicated in production 39, is set. 

41 <file-list> ::= <f i le-elemen t> 

42 ! <file-list> <f ile-elemen t> 

43 <files> ::= FD <id> <fi le-control> . 

<record-descr iption> 

This statement indicates the end of a record 
description, if there was an implied redefinition 
of the record, then the level stack (IDiSTACK) 
must be reduced. The length of the first record 
description and its address can now be loaded 
into the symbol table for the file name. 

44 <f ile-control> : := <file-list> 

The address of the symbol table entry for the 
record describing the file name is enterei into an 
attribute of the file name symbol table entry, 
while the address of the file names symbol table 
entry is entered into an attribute of the same 
record . 

45 ! <empty> 

Same as 44 above. 
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4:6 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 



<file-list> ::= <f i le-element> 

! <file-list> <f ile-elemen t> 

<file-element> : := BLOCK <integer> RECORDS 

! RECORD <rec-count> 

The record length is saved for comparison with 
the calculated length from the picture clauses. 

i LABEL RECORDS STANDARD 
j LABEL RECORDS OMITTED 
! VALUE OE <id-s tring> 

<rec-count> : := <integer> 

I <integer> TO <integer> 

The TO option is the only indication that the file 
will he variable length. The maximum length must be 
saved . 

<work> ::= WORKING-STORAGE SECTION . <record-description> 
If the level stack (ID$STACK) contains a record 
identifier with a level number greater than one, 
then the stack must be reduced. The reduction 
depends on whether the identifier on the top of 
the stack is a redefinition of the item beneath 
it or not. The primary action is to assign the 
proper amount of storage to the last record in 
the WORKING STORAGE SECTION. 

! <empty> 

<link> ::= LINKAGE SECTION . <record-des cri pt i on> 

! <empty> 

<record-description> ::= <level-en try> 
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60 ! <record-descriptioa><level-entry> 

61 <level-ent ry> ::= <integer> <data-id> <redefines> 

<data-type> . 

The symbol table address for the level entry 
identifier is loaded into the level stack 
(ID$STACK). The level stack keeps track of the 
nesting of field definitions (elementary items) 
in a record in the FILE and WORKING STORAGE 
SECTIONS. At this point there may be no infor- 
mation about the length of the item being defined 
and its attributes may depend entirely upon its 
constituent fields. Within the FILE SECTION, 
multiple record descriptions for a file are 
assumed to be redefinitions of the first record 
description. In the WORKING STORAGE SECTION, if 
there is a VALUE CLAUSE, the stack level to which 
it applies is saved in PSNDI NG$ LITERAL , the level 
entry number is saved in 7ALUS$LEVEL and a fla«, 
VALUE$FLAG, is set. 

62 <data-id> ::= <id> 

63 ' FILLER 

An entry is built in the symbol table to record 
information about this record field. It cannot be 
used explicitly in a program because it has no name, 
but its attributes will need to be stored as part of 
the total record. 

64 < redefines ) : := REDEFINES <id> 
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The redefines option gives new attributes to a 
previously defined record area. The symbol table 
pointer to the area being redefined is saved in an 
attribute of the redefining identifier's symbol table 
entry, so that Information can be transferred to the 
area by either identifier. In addition to the inform- 
ation saved relative to the redefinition, it is nec- 
essary to check to see if the current identifier's 
level number is less than or equal to the level number 
of the identifier currently on the top of the level 
stack. If this is true, then all information for the 
item on top of the stack has been saved and the stack 
can be reduced. If the current identifier is a redef- 
inition of another identifier, the stack entry for the 
record being redefined is not removed until the first 
non-redefinition of a current identifier at the same 
level . 

65 ! <empty> 

As in production 64, the stack (ID$STACK) is checked 
to determine if the current level number indicates a 
reduction of the level stack is necessary. In add- 
ition, special action needs to be taken if the new 
level is 01. If an 01 level is encountered at this 
production prior to production 39 or 43 (the end of 
the file area), it is an implied redefinition of the 
previous 01 level record. In the WORKING STORAGE 
SECTION , it indicates the start of a new record. 
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66 


<data-type > : : = 


<prop-list> 


67 


1 

1 


<empty> 


68 


<prop-list> : := 


<data-element> 


69 


1 

I 


<prop-list> <data-element> 


70 


<data-element> 


: := PIC <input> 



The <input> at this point is the character string 
that defines record field. It is analyzed and the 
necessary extracted information is stored in the 
symbol table. 

71 ! USAGE COMP 

The field is defined to a binary field; however, 
COMP has not been implemented, therefore, if 
there is an associated VALUE CLAUSE, the value is 
entered into the associated identifier's value 
storage location in display format. 

72 ! USAGE DISPLAY 

The DISPLAY format is the default, and thus no 
special action occurs. 

73 ! SIGN LEADING <separate> 

This production indicates the presence of a sign in 
a numeric field. The sign will be in a leading 
position. If the <separate> indicator is true, 
then the length will be one longer than the PICTURE 
CLAUSE, and the type will be changed to signed 
numeric leading and separate. 

74 i SIGN TRAILING <separate> 

The same information reo.uired by production 73 must 
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be recorded, but in this case the sign is trailing 
rather than leading. 
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! OCCURS <i ntege r> 

The type must be set to indicate multiple 



occurrences and the number of occurrences saved 



for commuting the space defined by this field. 
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SYNC <direction> 



Syncronization with a natural boundary is not 
required by this machine. 
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VALUE <li teral> 



The field being defined will be assigned an initial 
value determined by the value of the literal through 
the use of an INT operator. This is only valid in 
the WORKING-STORAGE SECTION. Note that numeric and 
signed numeric PICTURE CLAUSES will have a numeric 

— no quotes delimiting — VALUE CLAUSE, while 
alphanumeric and alpha types will have a nonnumeric 

— literal delimited with quotes — VALUE CLAUSE. 

73 <direction> ::= LEFT 

79 ! RIGHT 

30 ! <em?ty> 

81 <separate> ::= SEPARATE 

The separate sign indicator is set. 

82 ! <empty> 

83 <literal> : := <input> 

The input string is checked to see if it is a valid 
numeric literal, and if valid, it is stored to be 
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used in a value assignment. 



84 


! <lit> 








This literal is a quoted string. 






85 


! ZERO 








As the case of all literals, the fact 


that there 




is a pending literal needs to be saved 


. In 


this 




case and the three following cases, an indicator 




of which literal constant is being 


saved 


is 




all that is required. The literal value can 


be 




reconstructed later. 






86 


! SPACE 






87 


! QUOTE 






88 


<integer> <input> 







The input string is converted to an integer value 
for later internal use. 

39 <id> : := < input> 

The input string is the name of an identifier and 
is checked aginst the symbol table. If it is in the 
symbol table, then a pointer to the entry is saved. 

If it is not in the symbol table, then it is 
entered and the address of the entry is saved. 

D. INTERFACE ACTIONS 

When compilation is suspended in PART ONE of the 
compiler certain k:ey variables are saved for use in PART 
TWO. These variables are declared sequentially in PART ONE 
and are therefore located in contiguous memory in the 
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variable area of PAR? ONE. These variables consist of 
debugging toggles set when invoking the compiler , i.e. 
sequence or token numbers, a pointer to the next available 
address in the symbol table, a pointer to the next character 
in the input source file, the output file control block, the 
next address in the intermediate code area, the next address 
in the constants area, and the base address of the symbol 
table. These key variables, consisting of 48 bytes, are 
copied to the 48 bytes immediately below the IREADER routine 
to insure they are not destroyed when PART TWO of the 
compiler is brought into memory. Since the memory area 
required for PART ONE is larger than that required by PART 
TWO the symbol table does not need to be relocated. Since 
the symbol table is not altered when PART TWO of the 
compiler is brought into memory only the base address of the 
symbol table and the last address of the symbol table need 
be saved to insure that access to the symbol table can be 
continued in PART TWO. See Figure [II-9] for an illustration 
of the memory organization when control is transfered from 
PART ONE to IREADER. The IREADER rountine causes PART TWO of 
the compiler to be brought into memory starting at 100K and 
then transfers control to PART TWO of the Compiler. 

E . COMPILER MODULE "PART TWO" 

1 . Purpose 

The second part of the compiler scans and parses the 
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MICR0-CC30L source statements starting with the PROCEDURE 
DIVISION and generates the necessary intermediate code. 

2 . Control Actions 

The first action after control is transfered to PART 
TWO from the IREADER routine is to copy the 48 hytes of the 
information saved from PART ONE into associated variables in 
PART TWO. After these variables are initialized all 
references to files, symbol table entries, etc. can be made 
in PART TWO and compilation can continue. See Figure [11-10] 
for an illustration of the memory organization at the time 
PART TWO begins compilation. 

3. Symbol Table Entries 

Entries made in the symbol table by PART TWO will be 
those for paragraph labels encountered within the PROCEDURE 
DIVISION of the source program. 

4 . Intermediate Code Generation 

For an explanation of the pseudo-instructions that 
are generated by PART TWO refer to the compiler program 
listings and the parser actions below. Also, for general 
information on pseudo-instructions refer to section III — D - 
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j Top of Memory 



--> 



BDOS 



IREADER Routine 



PART ONE 
Saved Variables 



0D100H 

0D000H 

0CSDFH 



Free 

Memory 



Symbol 

Table 



-<< 



PART ONE 
Variable Area 



Top of 

Symbol Table 



PART ONE 



130H 



000H 



FIGURE 1 1-9 



MEMORY ORGANIZATION AFTER PART TWO IS COPIED INTO MEMORY 



-« 



BDOS 

IREADER Routine 



PART ONE 
Saved Variables 



Free 

Memory 



Symbol 

Table 



PART TWO 
Variable Area 



PART TWO 



Top of Memory 



0D100E 

0D000H 

0CFDF 



Top of Symbol 
Table from 
PART ONE 



100H 

000H 



FIGURE 11-10 



46 



5 . Parser Actions 



The actions corresponding to each parse step in PART 
TWO are explained below. In each case, the grammar action 
that is being applied is given, and an explanation of what 
program actions take place for that step has been included. 
In describing the actions taken for each parse step there 
has been no attempt to describe how the symbol table entries 
are made, what pseudo instructions are generated or how the 
values are preserved on the stack. The intent of this 
section is to describe what information needs to be retained 
and at what point in the parse it can be determined. Where 
no action is required for a given statement, or where the 
only action is to save the contents of the top of the stack, 
no explanation is given. 

1 <p-div> ::= PROCEDURE DIVISION <using> . 

<proc-body> EOF 

This production indicates termination of the 
compilation. If the program has sections, then 
it will be necessary to terminate the last section 
with a RET 0 instruction. The code will be ended 
by the output of a TER operation. 

2 <using> ::= USING <id-string> 

Not implemented. 

3 ! <empty> 

4 <id-string> ::= <id> 

The identifier stack is cleared and the symbol 
table address of the identifier is loaded into 
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the first stack location. 



5 i <id-string> <id> 

The identifier stack is incremented and the symbol 
table pointer stacked. 

6 <proc-body> : := <paragraph> 

7 I <proc-body> <paragraph> 

8 <paragraph> ::= <id> . <sentence-list> 

The starting and ending address of the paragraph 
are entered into the symbol table. A return is 
emitted as the last instruction in the paragraph 
(RET 0). When the label is resolved, it may be 
necessary to produce a 3ST operation to resolve 
previous references to the label. 

9 ! <id> SECTION . 

The starting address for the section is saved. If 
it is not the first, then the previous 
section ending address is loaded and a return 
(RET 0) is output. As in production 6, a 3ST may- 
be produced. 

10 <sentence-list> ::= <sentence>. 

11 ! <sentence-list> <sentence> . 

12 <sentence> ::= <imperative> 

13 ! <condi tional> 

14 i ENTER <id> <opt-id> 

This construct is not implemented. An ENTER allows 
statements from another language to inserted in the 
source code. 
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15 <imperative> t := ACCEPT <subid> 

ACC <address> <length> 

16 i <arithmetic> 

1? ! CALL <llt> <us ing> 

This is not implemented. 

18 ! CLOSE <id> 

CLS <file control block address> 

19 ! <f ile-ac t> 

20 ! DISPLAY <li t/id> <opt-lit/id> 

The display operator is produced for the first 
literal or identifier (DIS <address> <length> <flag>) 
If the second value exists, the same code is also 
produced for it. The only difference in the two 
display outputs is the flag is set to zero on the 
first display to surpress the carriage return and 
line feed. 

21 j EXIT <program-id> 

RET 0 

22 ! GO <id> 

ERN <address> 

23 ! GO <id-string> DEPENDING <id> 

GDP is output, followed hy a number of parameters 
<the number of entries in the identifier stac!c> 

<the length of the depending identified <the 
address of the depending identified < the address 
of each identifier in the stack>. 
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24 ! MOVE <1 i t/id> TO <subid> 

The types of the two fields deterrine the move that 
is generated. Numeric moves go through register two 
using a load and a store. Non-numeric moves depend 
upon the result field and may he either MOV, MED or 
MNE. Since all of these instructions have long 
parameter lists, they have not been listed in 
de tail . 

25 | OPEN < type-act ion> <id> 

This produces either OPN, 0?1 , or 0P2 depending 
upon the < type-ac ti on> . Each of these is followed 
by file control block address. 

26 ! PERFORM <id> <thru> <finish'; 

The PER operation is generated followed by the 
<branch address> <the address of the return 
statement to be set> and <the next instruction 
address> . 
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! <read-id> 


23 


! STOP <terminate> 



If there is a terminate message, then STD is 
produced followed by Cmessage aadress> <message 
length>. Otherwise ST? is emitted. 

29 <conditi onal> ::= <arithmetic> <size-error> <imperative> 

A 3ST operator is output to complete the branch around 
the imperative from production 65. 

30 ! <file-act> <invalid> <imperative> 

A 3ST operator is output to complete the branch from 
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production 64. 



31 ! < if-nont erm mal > <condition> <action> 

ELSE <imperative> 

NEG will be emmitted unless <condition> is a 
’NOT <cond-type>" , in which case the two negatives 
will cancel each other. Two 3ST operators are required. 
The first fills in the branch to the ELSE action. The 
second completes the branch around the <imperative> 
which follows ELSE. 

32 ! <read-id> <s?ecial> <imperative> 

A 3ST is produced to complete the b ranch around the 
<imperat ive> . 

33 < Ari thmet i c> ::= ADD <l/id> <opt-l/id> TO <subid> 

< round > 

The existence of multiple load and store instructions 
ma’rce it difficult to indicate exactly what code will 
be generated for any of the arithmetic instructions. 
The type of load and store will depend on the nature 
of the number involved, and in each case the standard 
parameters will be produced. This parse step will in- 
volve the following actions: first, a load will be em- 
itted for the first number into regster zero. If 
there is a second number, then a load into register 
one will be produced for it, followed by an ADD and a 
STI. Next a load into register one will be generated 
for the result number. Then an ADD instruction will 
be emitted. Finally, if the round indicator is set, a 
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RND operator will be produced prior to the store. 

34 j DIVIDE <l/id> INTO <subid> <round> 

The first number is loaded into register zero. The 
second operand is loaded into register one. A DIV 
operator is generated, followed by a RND operator prior 
to the store, if required. 

35 ! MULTIPLY <l/id> BY <subid> <round> 

The multiply is the same as the divide except that a 
MUL operator is generated. 

36 ! SUBTRACT <l/id> <opt-l/id> PROM 

<subid> <round> 

Subtaction generates the same code as the ADD except 
that a SUB is produced in place of the last ADD. 

3? <file-act> ::= DELETE <id> 

Either a DLS or a DLR will be produced along with the 
required parameters. 

38 ! REWRITE <id> 

Either a F.WS or a RWR is emitted, followed by parame- 
ters. 

39 ! WRITE <id> <special-act> 

There are four possible write instructions: WTP, WV1, 
WHS, and WRR . 

40 <condition> ::= < 1 i t > <not> <cond-t.ype> 

One of the compare instructions is produced. They are 
CAL, CNS, CNU, RGT , RLT , REO, SOT, SLT , and SEC. 

Two load instructions and a SUB will also be generated 
if one of the register comparisons is reouired. 
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41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 



<cond-type> ::= NUMERIC 

! ALPHABETIC 
I <compare> <lit/id> 

<not> ::= NOT 

NEC Is emitted unless the NOT is part of an I? 
statement in which case the NEC in the IE 
statement is cancelled. 

! <empty> 

<compare> ::= GREATER 
! LESS 
! EQUAL 
<R0UND> ROUNDED 

! <empty> 

<terminate> <literal> 

! RUN 

<special> ::= <invalid> 

! END 

An SRO operator is emitted followed by a zero. The 
zero acts as a filler in the code and will be dack- 
stuffed with a branch address. In this production 
and several of the following, there is a forward 
branch on a false condition past an imperative action. 
For an example of the resolution, examine production 32. 
<o?t-id> : := <subid> 

' <empty> 

<action> : := <im?erative> 

BRN 0 
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5a 

59 

60 

61 

62 

53 

64 

65 

66 

6? 

63 

69 

70 

71 

74 

75 

76 

77 

78 



! NEXT SENTENCE 

ERN 0 

< thru> : := THRU <id> 
i <empty> 

<finish> : := <l/id> TIMES 

LDI <address> <length> DEC 0 
! UNTIL <condition> 

I <empty> 

<invalid> INVALID 

INV 0 

<size-error> :: = SIZE ERROR 
SER 0 

<special-act> <when> ADVANCING <hov-many> 

! <empty> 

<when> BEFORE 

! AFTER 

<hcv-many> : : = <integer> 

! PAGE 

! 1-0 

<subid> = <subscript> 

! <id> 

<integer> ::= <input> 

The value of the input string is saved as an inter 
number . 

<id> : := <input> 

The identifier is checked aginst the symbol table, 
it is not present, it is entered as an unresolved 
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79 

80 

81 

32 

33 

84 

85 

86 

87 

86 

8S 

90 

91 

92 



label . 



<l/id> : : = <input> 

The input value may he a numeric literal. If so, it 
is placed m the constant area with an INT operand. 
If it is not a numeric literal, then it must he an 
identifier, and it is located in the symbol table. 

! <subscript> 

I Z E rt 0 

<subscript> : := <id> ( <input> ) 

If the identifier was defined with a USING option, 
then the input string is checked to see if it is a 
number or an identifier. If it is an identifier, 
then an SCR operator is produced. 

<opt-l/id> : := <l/id> 

! <empty> 

<nn-lit> : := <lit> 

The literal string is placed into tne constant area 
using an INT operator. 

! SPACE 
j QUOTE 

<literal> ::= <nn-lit> 

! <input> 

The input value must be a numeric literal to be valid 
and is leaded into the constant area using an INT. 

! ZERO 

<lit/ii> ::= <l/id> 

J <nn-lit> 
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93 


< opt-li t/id> 


::= <lit/id> 
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! <emp ty> 
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<program-id> 


::= <id> 
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! <empty> 


9? 


<read-id> ::= 


READ <id> 



There are four read, operations: RDE, RVL , RRS , 

RHP. 



93 <if-nonterminal> : :=I? 



and 
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III. N PS MI CRO-COBOL INTERPRETER 



A. GENERAL DESCRIPTION 

The following sections describe the NPS MICRO-COBOL 
pseudo-machine in terms of the implementation, memory 
organization, interface actions and interpreter 
instructions. The pseud o-machinp , which is constructed in 
the transient program area of CP/M, is the target machine 
for the compiler and is implemented through a programmed 
interpreter. The interpreter decodes each operation and 
either calls subroutines to perform the required actions or 
acts directly on the run time environment to control the 
actions of the interpreter. All communications between 
instructions is done through common areas in the program 
where information can be stored for later use. See figure 
[III-l] for an illustration of the pseudo-machine 
orsani za ti on . 

The machine contains a program counter and multiple 
parameter operations which contain ail the information 
required to perform one complete action required by the 
language. Three eighteen digit registers are used for 
arithmetic operations, along with a subscript stack used to 
compute subscript locations, and a set of flags are used tc 
pass branching information from one instruction to another. 

Addresses in the pseudo-machine are represented by 16 
bit values. Any memory address greater than 23 hexidecimal 
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is valid . Addresses less than 22 hexidecimal will be 
interpreted as having special significance. For example 
addresses one through eight are reserved for subscript stack 
references. All other addresses in the machine are absolute 
add resse s . 

The registers allow manipulation of signed numbers up to 
eighteen digits in length. Included in their representation 
is a sign indicator and the position of the assumed decimal 
point for the currently loaded number. Numbers are 
represented in standard CCEOL "Display" format. These 
numbers may have separate signs indicated by " + " and or 
may have a "zone" indicator, denoting a negative sign, in 
the most significant byte of a number's storage location. 
Before operations occur on any number, it is converted to a 
packed decimal format and entered into one of the 
pseudo-machine registers. 

B. MEMORY ORGANIZATION 

The memory of the pseudo-machine is divided into three 
major areas: 1.) the data area is established by the DATA 
DIVISION statements of the source program, 2.) the constants 
area which is established by both the DATA and PROCEDURE 
DIVISIONS of the source program, and 3.) the code area which 
is established by the PROCEDURE DIVISION. 

The data area is the lowest area in the pseudo-machine. 
This area contains the storage for identifiers declared in 
the DATA DIVISION. Additionally, the data area contains the 
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File Control Block (FC3) and the buffer space (123 bytes) 
for all files declared in the source program. 

Immediately following the data area is the code area. 
This contiguous area of storage contains all executable code 
generated. The constants area is located in high memory of 
the pseudo-machine. This area contains all edit field masks 
as well as all numeric and non-numeric literals. Figure 
[III —1 ] ilustrates the memory organization of the 
pseudo-machine . 
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FIGURE III-l 
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INTERPRETER INTERFACE 



C . 



The interpreter consists of two interface routines and 
the main interpreter program. To execute the interpreter tne 
command EXEC <f ilename.f iletype>, (where file type is CIN), 
is typed at the terminal. This action causes the two 
interface routines, BUILD and INTRDR, to be brought into 
memory. See figure [II 1-2] which illustrates the memory 
organization immediately after BUILD and INTRDR have been 
copied into memory. The BUILD routine reads in the 
intermediate code, initializes all memory locations 
requiring initalization , and resolves all unresolved address 
references. The INTRDR routine reads the interpreter program 
into memory and transfers control to the interpreter 
program. 

The intermediate code instructions fall into two 
categories: 1.) instructions used by 3UILD to establish the 
run time environment and, 2.) instructions to be executed by 
the interpreter. The following four instructions are 
generated in the compiler for use by the 3UILD routine; SCD, 
I NT, 3ST , and TER. 

The SCD (start code) instruction is the last instruction 
generated by PART ONE and indicates where the first 
executable instruction for the intermediate code is to be 
loaded. This corresponds to the address immediately 
following the data area in the pseudo-machine. See Figure 
[III-l] which illustrates the relative location of the 
address that is associated with the SCD instruction. 
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MEMORY ORGANIZATION AFTER 3UILD AND INTRDR 
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FIGURE II 1-2 
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The INT (initialize) instruction causes the 3UILD 
routine to initialize the data area with the values 
associated with those identifiers in thp DAT4 DIVISION of 
the source program that had VALUE CLAUSES. In addition, the 
INT instruction causes the BUILD routine to initialize the 
constants area with all the edit masks for those identifiers 
of the numeric and alphanumeric edit type, and all literals 
encour.ted in the PROCEDURE DIVISION of the source program. 

The 3ST (backstuff) instruction resolves all unresolved 
references, i.e. branches to labels defined after the 
respective PERFORM or GO statement was encountered in the 
source program. 

The TER (terminate) instruction is the last instruction 
generated by PART TWO of the compiler and indicates the end 
of the intermediate code file. Upon encountering a TER 
instruction in the intermediate code the BUILD routine 
inserts a ST? instruction in its place. The ST? instruction 
will cause the interpreter to terminate interpretation of 
the program when encountered. 

All other code generated by the compiler is copied into 
the code area of the pseudo-machine by the BUILD routine. 
See Figure [III-3] for an illustration of the memory 
organization at this point in the initialization routine. 
The final action taken by the BUILD routine is to move the 
INTPDR routine into the input buffer at 80S and transfer 
control to INTRDR. This frees the area from 100H to the base 
of the data area for the interpreter. 
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The INTRDR routine reads the interpreter program into 
memory starting at 100H and transfers contol to it. From 
this point on the interpreter program executes the 
intermediate code that was loaded into the pseudo-machine. 
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D. PSEUDO-MACHINE INSTRUCTIONS 



This section briefly covers the pseudo-machine 
instructions used in the interpreter, their format, and the 
actions which they accomplish. 

1 . Format 

All of the interpreter instructions consist of an 
instruction number followed by a list of parameters. The 
following sections describe the instructions, list the re- 
quired parameters, and describe the actions taken by the 
machine in executing each instruction. In each case, parame- 
ters are denoted informally by the parameter name enclosed 
in brackets. The BRN branching instruction, for example, 
uses the single parameter Cbranch address> which is the tar- 
get of the unconditional branch. 

As each instruction number is fetched from memory, 
the program counter is incremented by one. The program 
counter is then either incremented to the next instruction 
number, or a branch is taken. 

The three eighteen digit registers which are used by 
the instructions covered in the following sections are re- 
ferred to as registers zero, one, and two. 

2 . Arithmetic Operations 

There are five arithmetic instructions which act 
upon the three registers. In all cases, the result is 
placed in register two. Operations are allowed to destroy 
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the input values during the process of creating a result, 
therefore, a number loaded into a register is not available 
for a subsequent operation. 

ADD: (addition). Sum the contents of register zero 
and register one. 

Parameters: no parameters are required. 

SUE: (subtract). Subtract register zero from register 

one . 

Parameters: no parameters are required. 

MUL: (multiply). Multiply register zero by register 

one . 

Parameters: no parameters are required. 

DIV: (divide). Divide register one by the value in 
register zero. The remainder is not retained. 

Parameters: no parameters are reouired 

RND:(round). Round register two to the last signifi- 
cant decimal place. 

Parameters: no parameters are required. 

3 . Branching 

The machine contains the following flags which are 
used by the conditional instructions in this section. 

BRANCH flag — indicates if a branch is to be taicen* 
END OF RECORD flag — indicates that an end of 
input condition has been reached when an attempt was made 
to read input; 

OVERFLOW flag — indicates the loss of information 
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from a register due to a number exceeding the available 
size; 

I MVALID flag — indicates an invalid action in 
writing to a direct access storage device. 

All of the branch instructions are executed by 
changing the value of the program counter. Some are uncon- 
ditional branches and some test for condition flags which 
are set by other instructions. A conditional branch is exe- 
cuted by testing the branch flag which is initialized to 
false. A true value causes a branch by changing the pro- 
gram counter to the value of the branch address. The branch 
flag is then reset to false. A false value causes the pro- 
gram counter to be incremented to the next sequential in- 
struction. 

3RM : (branch to an address). Load the program 

counter with the <branch address>. 

Parameters: <branch address> 

The next three instructions share a common format. 
The memory field addressed by the <memory aidress> is 
checked for the <address length>, and if all the characters 
match the test condition, the branch flag is complemented 
Parameters: <memory address> <address length> <branch ad- 

dress > 

CAL: (compare alphabetic). Compare a memory field 

for alphabetic characters. 

CNS : (compare numeric signed). Compare a field for 

numeric characters allowing for a sign character. 
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CNU : (compare numeric unsigned). Compare a field for 
numeric characters only. 

DEC: (decrement a counter and branch if zero), 
decrement the value of the <address counter> by one; if the 
result is zero before or after the decrement, the program 
counter is set to the <branch address>. If the result is 
not zero, the program counter is incremented by four. 
Parameters: <address counter> <branch address> 

EOR : (branch on end of records flag). If the end- 

of-records flag is true, it is set to false and the program 
counter is set to the Cbranch address>. If false, the pro- 
gram counter is incremented by two. 

Parameters: <branch address> 

G-DP : (go to - depending on). The memory location ad- 
dressed by the <number address> is read for the number of 
bytes indicated by the <memory length>. This number indi- 
cates which of the ^branch addresses> is to be used. The 
first parameter is a bound on the number of branch ad- 
dresses. If the number is within the range, the program 
counter is set to the indicated address. An cut-of-bounds 
value causes the program counter to be advanced to the next 
sequential instruction. 

Parameters: <bound number - byte> <memory length> Cmemory 

address> <branch addr-l> Cbranch addr-2> ... Cbranch addr-n> 
INV: (branch if invalid-file-action flag true). If 
the invalid-file-action flag is true, then it is set to 
false, and the program counter is set to the branch ad- 
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dress. If it is false, the program counter is incremented 
by two. 

Parameters: Cbranch address> 

PER: (perform). The code address addressed by the 
<change address> is loaded with the value of the <return ad- 
dress)*. The program counter is then set to the <branch ad- 
dress> . 

Parameters: <branch address> <change address> <retum ad- 

dress> 

RET: (return). If the value of the <branch address> 
is not zero, then the program counter is set to its value, 
and the <branch address> is set to zero. If the <branch ad- 
dress> is zero, the program counter is incremented by two. 
Parameters: <branch address> 

REO: (register equal). This instruction checks for a 
zero value in register two. If it is zero, the branch flag 
is complemented. A conditional branch is taken. 

Parameters: <branch address> 

RGT: (register greater than). Register two is 
checked for a negative sign. If present, the branch flag is 
complemented. A conditional branch is taken. 

Parameters: <branch address> 

RLT : (register less than). Register two is checked 
for a positive sign, and if present, the branch flag is com- 
plemented. A conditional branch is taken. 

Parameters: <branch address> 

SER: (branch on size error). If the overflow flag is 
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true, then the program counter is set to the branch address, 
and the overflow flag is set to false. If it is false, then 
the program counter is incremented by two. 

Parameters: <branch address> 

The next three instructions are of similar form in 
that they compare two strings and set the branch flag if 
the condition is true. 

Parameters: <string addr-l> <string addr-2> <length - ad- 

dress> <branch address> 

SEQ: (strings equal). The condition is true if the 
strings are equal. 

SGT: (string greater than). The condition is true if 
string one is greater than string two. 

SLT: (string less than). The condition is true if 
string one is less than string two. 

4 . Move s 

The machine supports a variety of move operations 
for various formats and types of data. It does not suoport 
direct moves of numeric data from one memory field to anoth- 
er Instead, all of the numeric moves go through the regis- 
ters . 

The next seven instructions all perform the same 
function. They load a register with a numeric value and 
differ only in the type of number that they expect to see in 
memory at the ^number address>. All seven instructions 
cause the program counter to be incremented by five. Their 
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common format is given below. 

Parameters: -(number address> (byte length> <byte decimal 

count> <byte register to loaa> 

LCD: (load literal). Register two is loaded with a 
constant value. The decimal point indicator is not set in 
this instruction. The literal will have an actual decimal 
point in the string if required. 

LD1 : (load numeric). Load a numeric field. 

LD2: (load postfix numeric). Load a numeric field 

with an internal trailing sign. 

LD3: (load prefix numeric). Load a numeric field 

with an internal leading sign. 

LD4: (load separated postfix numeric). Load a numer- 
ic field with a separate leading sign. 

LD5 : (load separated prefix numeric). Load a numeric 
field with a separate trailing sign. 

LD6: (load packed numeric). Load a packed numeric 

field. 

MED: (move into alphanumeric edited field). The 

edit mask is loaded into the <to address> to set up tne 
move, and then the <from address> information is loaded. The 
program counter is incremented by ten. 

Parameters: <to address> <from address> (length of move> 

(edit mask address> (edit mask length> 

MNE : (move into a numeric edited field). First the 
edit mask is loaded into the receiving field, and then the 
information is loaded. Any decimal point alignment required 
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will be performed. If truncation of significant digits is a 
side effect, the overflow flag is not set. The program 
counter is incremented by twelve. 

Parameters: <to address> <from address> <address length of 
move> <edit mask address> <address mask length> <byte to de- 
cimal count> <byte from decimal count> 

MOV: (move into an alphanumeric field). The memory 
field given by the <to address> is filled by the from field 
for the <move length> and then filled with blanks in the 
following positions for the <fill count>. 

Parameters: <to address> <from address> <address move 
length> ^address fill count> 

STI: (store immediate register two). The contents of 
register two are stored into register zero and the decimal 
count and sign indicators are set. 

Parameters: none. 

The store instructions are grouped in the same order 
as the load instructions. Register two is stored into 
memory at the indicated location. Alignment is performed 
and any truncation of leading digits causes the overflow 
flag to be set. All five of the store instructions cause 
the program counter to be incremented by four. The format 
for these instructions is as follows. 

Parameters: <address to store into> <byte length> <byte de- 
cimal count> 

STO: (store numeric). Store into a numeric field. 

STI: (store postfix numeric). Store into a numeric 
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field with an internal trailing sign. 

ST2: (store prefix numeric). Store into a numeric 

with an internal leading sign. 

ST3: (store separated postfix numeric). Store into a 
numeric field with a separate trailing sign. 

ST4: (store separated prefix numeric). Store into a 
numeric field with a separate leading sign. 

ST5: (store packed numeric). Store into a packed 

numeric field. 

5 . Input-Output 

The following instructions perform input and output 
operations. Files are defined as having the following 
characteristics: they are either sequential or random 

and, in general, files created in one mode are not required 
to he readable in the other mode. Standard files consist 
of fixed length records, and variable length files need not 
be readable in a random mode. Further, there must be 
some character or character string that delimits a variable 
length record. 

A.CC : (accept). Read from the system input device 

memory at the location given by the <memory address>. The 
program counter is incremented by three. 

Parameters: <memory address> <byte length of read> 

CIS: (close). Close the file whose file control 

block is addressed by the <fcb address>. The program counter 
is incremented by two. 
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Parameters: <fcb address> 



DIS : (display). Print the contents of the data field 
pointed to by <memory address^ on the system output device 
for the indicated length and advance the line output if 
<f lag> is set. The program counter is incremented by four. 
Parameters: <memory address> <byte length> <flag> 

There are three open instructions with the same for- 
mat. In each case, the file defined by the file control 
block referenced will be opened for the mode indicated. The 
program counter is incremented by two. 

Parameters: <fcb address> 

OPN: (open a file for input). 

CPI: (open a file for output). 

0P2: (open a file for both input and output). This 
is only valid for files on a random access device. 

The following file actions all share the same for- 
mat. Each performs a file action on the file referenced by 
the file control block. The record to be acted upon is 
given by the <record address>. The orogram counter is in- 
cremented by six. 

Parameters: <FCB address> <record addressb Crecord length - 

addres s> . 

ELS : (delete a record from a sequential file). Re- 
move the record that was just read from the file. The file 
is required to be open in the input-output mode. 

RDF: (read a sequential file). Read the next record 
into the memory area. 
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WTF: (write a record to a seauential file). Append a 
new record to the file. 

RVL: (read a variable length record). 

WVL: (write a variable length record). 

RWS : (rewrite seauential). The rewrite operation 
writes a record from memory to the file, overlaying the last 
record that was read from the device. The file must be open 
in the input-output mode. 

The following file actions require random files 
rather than sequential files. They make use of a random file 
pointer which consists of a <relative address> and a <re- 
lative length>. The memory field holds the number to be 
used in disk operations or contains the relative record 
number of the last di.sk action. The relative record number 
is an index into the file which addresses the record being 
accessed. After the file action, the program counter 
is incremented by nine. 

Parameters: <?CB address> <record address> <record length - 

address> <relative address> <relative length - byte>. 

DLR: (delete a random record). Delete the record ad- 
dressed by the relative record number. 

RRR: (read random relative). Read a random record 
relative to the record number. 

RRS : (read random sequential). Read the next sequen- 
tial record from a random file. The relative record number 
of the record read is loaded into the memory reference. 

RWR: (rewrite a random record). 
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WRR : (write random relative). Write a record into 
the area indicated by the memory reference. 

WRS : (write random sequential). Write the next 
sequential record to a random file. The relative record 
number is returned. 

6 . Special Instructions 

The remaining instructions perform special functions 
required by the machine that do not relate to any of the 
previous groups. 

NSG : (negate). Complement the value of the branch 

flag. 

Parameters: No parameters are reauired. 

LDI: (load a code address direct). Load the code 
address located five bytes after the LDI instruction with 
the contents of Oemory address> after it has been converted 
to hexidecimal. 

Parameters: <memory address> <length - byte> 

SCR: (calculate a subscript). Load the subscript 
stack with the value indicated from memory. The address 
loaded into the stack is the <initial address) plus an 
offset. Multiplying the <field length) by the number in the 
<memory reference) gives the offset value. 

Parameters: <initial address) <field length) <memory refer- 

ence) <memory length) <stack level) 

STD: (stop display). Display the indicated informa- 
tion and then terminate the actions of the machine. 



77 



Parameters: <memory address> <length - byte> 

STP: (stop). Terminate the actions of the machine. 
Parameters: no parameters are required. The following in- 

structions are used in setting up the machine environment 
and cannot he used in the normal execution of the machine. 

EST: (backstuff). Resolve a reference to a label. 

Labels may be referenced prior to their definition, requir- 
ing a chain of resolution addresses to be maintained in the 
code. The latest location to be resolved is maintained in 
the symbol table and a pointer at that location indicates 
the next previous location to be resolved. A zero pointer 
indicates no prior occurrences of the label. The code ad- 
dress referenced by <change address> is examined and if 
it contains zero, it is loaded with the <new address)-. If 
it is not zero, then the contents are saved, and the 
process is repeated with the saved value as the change ad- 
dress after loading the <new address)-. 

Parameters: <change address)- <new address)- 

IMT: (initialize memory). Load memory with the <in- 
put string> for the given length at the <memory address>. 
Parameters: <memory address)- <address length> <input 

string)- 

SCL : (start code). Set the initial value of the pro- 
gram counter. 

Parameters: <start address> 

TER: (terminate). Terminate the initialization pro- 
cess and start executing code. 
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Parameters : 



no parameters 



are required. 
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IV . SYSTEM DEBUGGING METHODS MD TOOLS 



Initially it appeared that the debugging of the compiler 
and interpreter would be straight forward. However, it 
became apparent that a systematic approach would have to be 
adopted in order to meet the objectives. As previously 
stated, the first step was to determine the degree to which 
the compiler had been developed. After accomplishing this 
task, the next step was to identify the means by which 
errors could be located and the methods by which solutions 
could be implemented and tested. 

The method used to identify errors within the compiler 
consisted of the following: 1.) compiling test programs and 
denoting any compilation errors and 2.) examination of the 
symbol table construction and intermediate code instructions 
generated by compiling through the DATA DIVISION of a source 
program . 

A minimum of forty-five minutes was required to 
recompile either module — PART ONE or PART TWO — of the 
compiler after making changes, because the object code 
produced by the compiler had to be linked and loaded. This 
indicated a need to find and use an alternative approach for 
testing proposed changes. The approach used, was to test 
compiler and interpreter modifications by using interactive 
debugging tools before changing the compiler's source code 
and recompiling. This reduced the amount of time that vouli 
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otherwise have been required by reducing the total number of 
recompilations . 

4. DEBUGGING METHODOLOGY 

The debugging methodology utilized, consisted of steps 
similar to those suggested by Polya's problem-solvins 
technique [16]. Eirst, upon encountering an occurrence of an 
error, the approach was to understand why the error 
occurred. This included determining what the compiler or 
interpreter had done right in its compilation or execution 
of a source program, followed by an analysis of what the 
compiler or interpreter had done incorrectly. Second, a 
theory was devised to explain the nature of the errcr(s), 
along with a devised method, such as a paper and pencil wali 
through using different variables or combinations of 
variables, to confirm the theory. Next, the plan concerning 
the error was implemented, usually this was accomplished by 
a paper and pencil code walk through followed by 
recompilation and reexecution of the program. Einally. a 
solution was determined, reviewed, and implemented. 

It was observed, as in other program debugging efforts, 
that a few errors gave most of the difficulties encountered 
when debugging. Upon several occasions, it was thought that 
the origin and all side effects of an error had been 
discovered; later however, after bavins made a substantial 
coding change, it was realized that there was either another 
boundary condition, circumstance or combinatorial problem 
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giving rise to the error. The result was that of having to 
restudy and refix the error, which rea.uired additional time 
and effort. 

To facilitate the testing and debugging of the compiler 
and interpreter several different software tools were 
utilized. It is difficult to say which was the most 
beneficial? however, when they were used together the task 
of testing and debugging was significantly enhanced. 

3. INTERACTIVE TOOLS 

Because the MICR0-C050L compiler and interpreter were 
implemented under the C?/M operating system, two C?/M 
debugging facilities were used. First, the Dynamic Debugging 
Tool [7], DDT, is a dynamic interactive program whicn allows 
testing and debugging of programs in the CP/M operation 
system environment. The second was the Symbolic Instruction 
Debugger [6], SID, which expands upon the features of DET . 
Speci f ically , SID includes real-time breakpoints, fully 
monitored execution, symbolic disassembly, assembly, and 
memory display and fill functions. Both debuggers were 
designed to operate in an interactive mode and each had 
several features and facilities in common which enhanced the 
debugging effort. One feature which allowed the setting of 
breakpoints at actual memory locations corresponding to a 
program's source lines and symbolic names was used quite 
extensively. Another useful facility was the ability to 
display and alter the programs symbolic values, which 
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enabled the substitution of values to check: a proposed 

solution to an error. 

C. CROSS REFERENCE LISTINGS 

Another useful facility which eased the debugging effort 
was the cross reference listings produced by the PLM80 
compiler used to compile the MICR0-CO30L compiler and 
interpreter. There were three different listings produced 
after each compilation: 1.) a line numbered source listing, 

2. ) a symbol address table, which included the name and 
actual memory address assigned for all symbols declared, and 

3. ) a line address table which cross referenced every line 
in the source listing with the 8080 code generated by the 
PLM80 compiler for that particular line. These listings were 
almost indispensable with regard to testing and debugging, 
and their contribution cannot be overemphasized. 

D. VALIDATION TESTS 

At the onset of this thesis project it was very 
difficult to decide how to test various constructs and 
features of the MICRO-CCBOL compiler and interpreter and 
there were questions regarding test case design. During 
earlier work [15], the HIP0-C030L Compiler Validation System 
(HCCVS) Tape (from the Automated Data Processing Equipment 
Selection Office (ADPESO)) was acquired — to be used in 
validating the ,**1 CRO-COBOL compiler. However, the HCCVS was 



33 



never used and the tape had not been transferred to the 
appropriate media. This transfer was accomplished later 
[12]. 3y using the HCCVS as the evaluation package, the 
auestions regarding test case construction and design were 
resolved and testing proceeded. The HCCVS was used primarily 
as a test bed for PART ONE of the compiler, having as an 
objective the goal of ensuring the proper construction of 
the symbol table and data initialization. Because some of 
the FYP0-C030L constructs were not implemented in the 
MICRO-COBOL compiler (see Appendix E) , the compilation of 
any HCCVS program past the PROCEDURE DIVISION statement was 
no t successful . 
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V. CONCLUSIONS AND RECCMM.EN TAT IONS 



A significant portion of the MICRO-COBOL 
Compiler/Interpreter has been tested, debugged and 
documented. The following specific language features and 
facilities previously not implemented, or implemented 
incorrectly, have been successfully implemented, tested and 
debugged during this project: 1.) the compiler's ability to 
handle any sequence of MICRO-COBOL language constructs 
(PICTURE CLAUSE, VALUE CLAUSE, OCCURS CLAUSE, and USAGE COMP 
CLAUSE) in the declaration of an identifier, 2.) record 
identifier declarations with up to ten levels of elementary 
field items, 3.) record and elementary field identifier 
redefinitions, 4.) nested redefinitions, and 5.) error 
message generation for duplicate identifier declarations 
within the DAT A DIVISION. 

Testing and debugging has been accomplished for all 
presently implemented MICRO-COBOL language constructs 
occurring in the DATA DI VISION of a source program. 
Specifically, testing was performed by compiling through the 
DATA DIVISION of the first ten HCCVS test programs. 

In addition, the MICRO-COBOL compiler has been 
completely documented. This documentation includes the 
following: 1.) module organization, 2.) module interfaces, 
3.) memory organization of the Interpreter, 4.) construction 
and data initialization of the symbol table, and 5.) Key 



internal data structures. 



Several areas remain which could be improved, developed 
and implemented, to enhance the MICR0-C030L 
Compiler/Interpreter system, these include: 1.) correction 
of the numerical algorithms in the interpreter to allow for 
signed-fractional arithmetic, 2.) implementation of numeric 
editing capabilities, 3.) implementation of a printer 
control feature and interface, and 4.) testing and debugging 
of the compiler's ability to compile the PROCEDURE DIVISION 
of the HCCVS test programs. 
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APPENDIX A. 
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I. ORGANIZATION 



The compiler is designed to run on an 8082 system in an 
interactive mode through the use of a teletype or console. 
It requires at least 24K of main memory and a mass storage 
device for reading and writing. The compiler is composed of 
two parts , each of which reads a portion of the input file. 
Part One reads the input program to the end of the Data 
Division and builds the symbol table. At the end of the Data 
Division, Part One is overlayed by Part Two which uses the 
symbol table to produce the code. The output code is written 
as it is produced to minimize the use of internal storage. 

The BUILD Program builds the core image for the 
intermediate code and performs such functions as 
backs tuff ing addresses. BUILD then loads the INTERPRETER 
addresses. BUILD then transfers control to the INTRDR 
routine. The INTRDR routine copies the interpreter into 
memory and transfers control to the Interpreter. The 
interpreter is controlled by a large case statement that 
decodes the instructions and performs the required actions. 

As a tool for debugging the compiler the DECODE Program 
was created; it reads the intermediate code file and 
translates the instructions into mnemonics followed by 



parameters . 



II. MICRO-COBCL ELEMENTS 



This section contains a description of each element in 
the language and shows simple examples of their use. The 
following conventions are used in explaining the formats: 
Elements enclosed in broken braces < > are themselves 
complete entities and are described elsewhere in the manual. 
Elements enclosed in braces { } are choices, one of the 
elements which is to be used. Elements enclosed in brackets 
[ ] are optional. All elements in capital letters are 
reserved words and must be spelled exactly. 

User names are indicated in lower case. These names have 
been restricted to 12 characters in length. There is only 
one restriction on user names, the first character must be 
an alpha character. The remainder of the user name can have 
any combination of representable character in it. 

The input to the compiler does not need to conform to 
standard COBOL format. Eree form input will be accepted as 
the default condition. If desired, sequence numbers can be 
entered in the first six positions of each line. However, a 
toggle needs to be set to cause the compiler to ignore the 
sequence numbers . 
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IDENTIFICATION DIVISION 



ELEMENT: 

IDENTIFICATION DIVISION Format 



FORMAT: 



IDENTIFICATION DIVISION. 

PROGRAM-ID. <comment>. 

[AUTHOR. <comment>.] 

[DATE-WRITTEN. < commen t > . 1 
[SECURITY. <comment>.] 

DESCRIPTION : 

This division provides information for program 
tification for the reader. The order of the 1 
fixed . 

EXAMPLES : 

IDENTIFICATION DIVISION. 

PROGRAM-ID. SAMPLE. 

AUTHOR. MICHAEL-L-EICE. 



iden- 
nes is 
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ENVIRONMENT DIVISION 



ELEMENT: 

ENVIRONMENT DIVISION Format 
FORMAT: 

ENVIRONMENT DIVISION. 

CONFIGURATION SECTION. 

SOURCE-COMPUTER. <comment> [DEBUGGING MODE]. 
OBJECT-COMPUTER. <comment>. 

[INPUT-OUTPUT SECTION. 

FILE-CONTROL. 

<f ile-control-entry> . . . 

[I-O-CONTROL. 

SAME file-name-1 file-name-2 [file-name-3] 

[f i le-name-4] [file-name-5]. ] ] 

DESCRIPTION : 

This division determines the external nature o 
file. In the case of CP/M all of the files used 
he accessed either sequentially or randomly except 
variable length files which are sequential only, 
debugging mode is also set by this section. 



a 

ca n 
for 
The 
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<file-control-entry> 



ELEMENT: 

<f il e-con trol-ent ry> 
FORMAT: 

1 . 



SELECT file-name 

ASSIGN implementor-name 
[ORGANIZATION SEQUENTIAL] 

[ACCESS SEQUENTIAL] . 

2 . 

SELECT file-name 

ASSIGN implementor-name 
ORGANIZATION RELATIVE 

[ACCESS {SEQUENTIAL [RELATIVE data-name]}]. 
[RANDOM RELATIVE data-name } 



DESCRIPTION : 

The f ile-control-en try defines the type of file that 
the program expects to see. There is no difference on 
the diskette, hut the type of reads and writes that 
are performed will differ. For CP/M the implementor 
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name needs to conform to the normal specifications. 



EXAMPLES : 

SELECT CARDS 

ASSIGN CARD .FI L . 

SELECT RANDOM-FILE 

ASSIGN A. RAN 

ORGANIZATION RELATIVE 

ACCESS RANDOM RELATIVE RAND-FLAG. 
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DAT® DIVISION 



ELEMENT: 

DATA DIVISION Format 
FORMAT : 

DATA DIVISION. 

[FILE SECTION. 

[FD file-name 

[BLOCK integer-1 RECORDS] 

[RECORD [integer-2 TO] integer-3] 

[LABEL RECORDS {STANDARD}] 

{OMITTED } 

[VALUE OF implementor-name-1 literal-1 

[ implement or-name-2 literal-2] ... ]. 
[<record-descr ipt ion-en try>] ...] ... 
[WORKING-STORAGE SECTION. 
[<record-description-entry>] ... ] 

[LINKAGE SECTION. 

[<record-description-entry>] ... ] 
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DESCRIPTION: 



This is the section that describes how the data is 
structured. There are no major differences from stan- 
dard COBOL except for the following: 1. Label 
records make no sense on the diskette so no entry is 
required. 2. The VALUE OF clause likewise has no 
meaning for CP/M. 3. The linkage section has not been 
implemented . 

If a record is given two lengths as in RECORD 12 TO 
128, the file is taken to be variable length and can 
only be accessed in the sequential mode. See the sec- 
tion on files for more information. 
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<c cmmen t > 



ELEMENT: 

<c omment> 



FORMAT: 



any string of characters 
DESCRIPTION: 



A 


comment 


is a 


St 


ring 


of charac 


ters . I t 


ma 


7 


include 


an 


ything 


o the 
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han 


a period f 


olloved by 
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ank or a 
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served 


word , 


ei 


ther 


of which 


terminate 


th 


0 


string . 


Co 


mments 


may 


he 
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ty if desi 


red, but th 


e 


te 


rmi na t or 


is 


still 


requi 


red 


by 


the progra 


m . 









EXAMPLES : 

this is a comment 

an o the ronea 11 run together 

5080b 16K 
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<data-description-entry> 



ELEMENT: 

<data-description-entry> Format 



FORMAT: 



le vel-number {data-name} 

{FILLER } 

[REDEFINES data-name! 

[PIC character-string] 

[USACxE {COMP }] 

{DISPLAY} 

[SIGN {LEADING} [SEPARATE! } 

{TRAILING} 

[OCCURS integer] 

[SYNC [LEFT ]] 

[RIGHT] 

[VALUE literal] . 

DESCRIPTION: 

This statement describes the specific attributes of 
the data. Since the 8080 is a byte machine, there was 
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no meaning to the SYNC clause, and thus it has not 
been implemented. 



EXAMPLES : 

01 CARD-RECORD. 

02 PART PIC X ( 5 ) . 

02 NEXT-PART PIC 99V99 USAGE COMP. 

02 FILLER. 

03 NUMB PIC S9(3 ) 79 SIGN LEADING SEPARATE. 
03 LONG-NUMB 9(15). 

03 STRING REDEFINES LONG-NUMB PIC X ( 15 ) . 

02 ARRAY PIC 99 OCCURS 100. 
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PROCEDURE DIVISION 



ELEMENT : 



PROCEDURE DIVISION Format 
FORMAT: 

1 . 



PROCEDURE DIVISION [USING namel [name2] ... [name5] 1 . 
section-name SECTION. 

[paragraph-name. <sentence> [<sentence> ... 1 ... ] ... 



2 . 



PROCEDURE DIVISION [USING namel [name2] ... [name5]]. 
paragraph-name . <sentence> [<sentence> ...1 ... 

DESCRIPTION: 

As is indicated, if the program is to contain sec- 
tions, then the first paragraph must he in a section. 
The USING option is part of the interprogram communi- 
cation module and has not been implemented. 



120 



<senten ce> 



ELEMENT: 

<sentence> 



FORMAT: 



<imperative-statement> 

<conditional-statement> 

ENTER verb 
DESCRIPTION: 

All sentences other than ENTER fall in one of the two 
main catigories. ENTER is part of the interprogran 
communication module. 
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<imperative-statement> 



ELEMENT: 

<imperat ive -state me nt> 

FORMAT: 

The following verbs are always imperatives: 

ACCEPT 

CALL 

CLOSE 

DISPLAY 

EXIT 

CO 



MOVE 

OPEN 

PERFORM 

STOP 

The following may be imperatives: 

arithmetic verbs without the SIZE SE C .CR statement 

and DELETE, WRITE, and REWRITE without the INVALID option. 
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((conditional -s t a temen t s > 



ELEMENT : 

<conditional-statements> 



FORMAT: 



IF 

READ 



arithmetic verts with the SIZE ERROR statement 



and DELETE, WRITE, and REWRITE with the INVALID option. 



ACCEPT 



ELEMENT: 

ACCEPT 

*5 

FORMAT: 

ACCEPT <identifier> 

DESCRIPTION: 

This statement reads up to 255 characters from the 
console. The usage of the item must be DISPLAY. 
EXAMPLES : 

ACCEPT IMMAGS 

ACCEPT NUM ( 3 ) 
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ADD 



ELEMENT : 

ADD 

FORMAT: 

ADD {identifier} [{identifier-1}} TO identifier-2 
{literal } {literal } 

[ROUNDED] [SIZE EFROP. < imper a t iv e-s ta t emen t >] 
DESCRIPTION: 

This instruction adds either one or two numbers to a 
third with the result being placed in the last loca- 
tion. 

EXAMPLES : 

ADD 10 TO NUM31 

ADD X T TO Z ROUNDED. 

ADD 103 TO NUMBER SIZE ERROR GO ERROR -LCC 
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CALL 



ELEMENT : 

CALL 



FORMAT : 



CALL literal [USING namel [name2] . 



DESCRIPTION: 

CALL is not implemented. 



. [nameSll 
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CLOS 



ELEMENT: 

CLOSE 

FORMAT: 

CLOSE file-name 
DESCRIPTION : 

Files must be closed if they have been written. How 
ever, the normal requirement to close an input fil 
prior to the end of processing does not exist. 
EXAMPLES: 

CLOSE FI LEI 

CLOSE RANDFILE 
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DELET 



ELEMENT: 

DELETE 



FORMAT: 



DELETE file-name [INVALID <imperative-statement>] 



DESCRIPTION: 

This statement requires the file-name of the item 
to he deleted. The record is logically removed by 
filling it with a high value character, which is not 
displayabie to the console or line printer. The log- 
ical record space can be used again by writing a 
valid record in its place. 

EXAMPLES : 

DELETE FILE-NAME 
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DISPLAY 



ELEMENT: 

DISPLAY 

FORMAT: 

DISPLAY {identifier} [{identifier-1}] 

{ 1 i teral } {literal } 

DESCRIPTION : 

This displays the contents of an identifier or 
displays a literal on the console. Usage must he 
DISPLAY. The maximum length of the display is 30 char- 
acters for literal values and 255 characters for 
identifiers. Only two identifiers/literals are 
allowed for each DISPLAY command. 

EXAMPLES : 

DISPLAY MESSAGE-1 

DISPLAY MESSAGE-3 10 

DISPLAY 'THIS MUST PE THE END' 



ies 



ELEMENT : 



DIVIDE 

FORMAT: 

DIVIDE {identifier} INTO identifier-1 [ROUNDED] 
{literal } 

[SIZE ERROR imperative-statement >] 
DESCRIPTION: 

The result of the division is stored in identi 
any remainder is lost. 

EXAMPLES : 

DIVIDE NUMB INTO STORE 



DIVIDE 25 INTO RESULT 



ENT 



ELEMENT : 



ENTER 



FORMAT: 

ENTER language-name [routine-name] 



DESCRIPTION: 

This construct is not impl imented . 
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EXIT 



ELEMENT: 



EXIT 



FORMAT: 



EXIT [PROOF; AMI 
DESCRIPTION: 

The EXIT command causes no action by the interpreter 
but allows for an empty paragraph for the construction 
of a common return point. The optional PROGRAM state- 
ment is not implemented as it is part of the mterpro- 
gram communication module. 

EXAMPLES : 

RETURN. 

EXIT . 
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ELEMENT : 



GO 

FORMAT: 

1 . 

GO procedure-name 

2 . 

GO procedure-1 [procedure-2] ... procedure-20 
DEPENDING identifier 
DESCRIPTION: 

The GO command causes an unconditional branch 
routine specified. The second form causes a 
branch depending on the value of the contents 
identifier. The identifier must be a numeric 
value. There can be no more than 20 procedure 
EXAMPLES : 

GO P.SAD-C.? RD . 



to the 
f orva rd 
of the 
integer 
names . 



GO READ1 READ2 READS DEPENDING READ-INDEX. 



I? 



ELEMENT: 



IE 



FORMAT: 



IF <condition> {imperative } ELSE imperative-2 

{NEXT SENTENCE} 



DESCRIPTION : 

This is the standard COBOL IF statement. Note that 
there is no nesting of IF statements allowed since the 
IF statement is a conditional. 

EXAMPLES : 

IF A GREATEF B ADD A TO C ELSE GO ERROR-ONE. 

IF A NOT NUMERIC NEXT SENTENCE ELSE MOVE ZERO TO A. 
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MOVE 



ELEMENT: 

MOVE 

FORMAT: 

MOVE {identifier-1} TO identifier-2 
{literal } 

DESCRIPTION : 

The standard list of allowable moves applies to this 
action. As a space saving feature of this implementa- 
tion, all numeric moves go through the accumulators. 
This makes numeric moves slower than alpha-numeric 
moves, and where possible they should be avoided. Any 
move that involves picture clauses that are exactly 
the same can be accomplished as an alpha-numeric move 
if the elements are redefined as alpha-numeric; also 
all group moves are alpha-numeric. 

EXAMPLES : 

MOVE SPACE TO PRINT-LINE. 

MOVE A (12) TO B (PTR ) . 
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MULTIPLY 



ELEMENT: 



MULTIPLY 

FORMAT: 

MULTIPLY {identifier} BY identifier-2 [ROUNDED] 
{literal } 

[SIZE ERROR <imperat ive-s tatement >] 



DESCRIPTION: 

The multiply routine requires enougn space to calcu- 
late the result with the full number of decimal digits 
prior to moving the result into identifier-2. This 
means that a number with 5 places after the decimal 
multiplied by a number with 6 places after the decimal 
will generate a number with 11 decimal places which 
would overflow if there were more than 7 digits before 
the decimal place. 

EXAMPLES : 

MULTIPLY X EY Y. 

MULTIPLY i BY 3(7) SIZE ERROR 00 OVERFLOW. 
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OPEN 



ELEMENT: 

OPEN 
FORMAT : 

OPEN {INPUT file-name } 

{OUTPUT file-name) 

{ I — 0 file-name } 

DESCRIPTION: 

The three types of OPENS have exactly the same effect 
on the diskette. However, they do allow for internal 
checking of the other file actions. For example, a 
write to a file set open as input will cause a fatal 
error . 

EXAMPLES : 

OPEN INPUT CARDS. 

OPEN OUTPUT REPORT-FILE. 
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PERFORM 



ELEMENT: 

PERFORM 

FORMAT: 

1 . 



PERFORM procedure-name [THRU procedure-name-2] 

2 . 

PERFORM procedure-name [THRU procedure-r.ame-2] 
{identifier} TIMES 
{integer } 



3. 



PERFORM procedure-name [THRU procedure-r.ame-2] 

UNTIL <condition> 

DESCRIPTION: 

All three options are supported. Eranching may be ei- 
ther forward or backward, and the procedures called 
may have perform statements in them as long as the end 
points do not coincide or overlap. 

EXAMPLES : 

PERFORM OPEN-ROUTINE. 



ns 



PERFORM TOTALS THRU END-REPORT. 



PERFORM 

PERFORM 



SUM 10 TIMES . 

SKIP-LINE UNTIL PG-CNT GREATER 60. 
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P. E A D 



ELEMENT: 

READ 

FORMAT: 

1 . 



READ file-name INVALID <imperat i ve-s ta tement> 

2 . 

READ file-name END ‘C'impera t i ve-s ta temea t> 

DESCRIPTION: 

The invalid condition is only applicable to files in a 
random mode. All sequential files must have an END 
statement . 

EXAMPLES : 

READ CARDS END GO SND-OF-FILE. 

READ RANDOM-FILS INVALID MOVE SPACES TO REC-1. 
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REWRITS 



ELEMENT: 

REWRITE 
FORMAT : 

REWRITE record-name [INVALID <impera ti ve>] 

DESCRIPTION: 

REWRITE is only valid for files that are open in the 
1-0 mode. The INVALID clause is only valid for random 
files. This statement results in the current record 
"being written hack into the place that it was just 
read from, the last executed read. 

EXAMPLES : 

REWRITE CARDS. 

REWRITE R.&ND-l INVALID PERFORM ERROR-CHECK . 
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STOP 



ELEMENT: 



STOP 



FORMAT : 



STOP {RUN } 
{literal} 



DESCRIPTION: 

This statement ends the running of the interpreter. 
If a literal is specified, then the literal is 
displayed on the console prior to termination of the 
pr o g ra m . 

EXAMPLES: 

STOP RUN . 

STOP 1. 

STOP "INVALID FINISH”. 
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SUBTRACT 



ELEMENT: 

SUBTRACT 

FORMAT: 

SUBTRACT {identifier-1} [identifier-2] FROM identifier-3 
{literal-1 } [literal-2 ] 

[ROUNDED! [SIZE ERROR <imperative-s ta tement>] 
DESCRIPTION: 

Identifier-3 is decremented by the value of 

identifier/literal one, and, if specified, 

identifier/literal two. The results are stored back 
in identifier-3. Rounding and size error options are 
available if desired. 

EXAMPLES : 

SUBTRACT 10 FROM SU3(12). 

SUBTRACT A B FROM C ROUNDED. 
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WRIT 



ELEMENT : 

WRITE 



FORMAT : 

1 . 



WRITE record-name [{BEFORE} ADVANCING {INTEGER}] 

{AFTER } {PAGE } 



2 . 



WRITS record-name INVALIE <impe rat i v e-s ta t ement > 
DESCRIPTION: 

The record specified is written to the file 
specified in the file section of the source 
program. The INVALID option only applies to 
random files. 

EXAMPLES : 

WRITE OUT-FILS. 

WRITE FAND-FILE INVALID PERFORM ERROR-RECOV. 
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<condit ion> 



ELEMENT: 

<condition> 



FORMAT: 

RELATIONAL CONDITION : 

{identifier-1} [NOT! {GREATER } {identifier-2} 
{literal-1} {LESS } {literal-2 } 

{EQUAL } 

CLASS CONDITION: 

identifier [NOT] {NUMERIC } 

{ALPHABETIC} 



DESCRIPTION : 

It is not valid to compare two literals. The class 
condition NUMERIC will allow for a sign if the iden- 
tifier is signed numeric. 

EXAMPLES : 

A NOT LESS 10. 

LINE GREATER ’c". 

NUMB1 NOT NUMERIC 
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Subscripting 



ELEMENT : 

Subscripting 



FORMAT : 



data-name (subscript) 

DESCRIPTION: 

Any item defined with an OCCURS may be referenced by 
a subscript. The subscript may be a literal integer, 
or it may be a data item that has been specified as an 
integer. If the subscript is signed, the sign must be 
positive at the time of its use. 

EXAMPLES : 

A (10) 

ITEM (SUB) 
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Ill . COMPILER TOGGLES 



There are four compiler toggles which are controlled ty 
an entry following the compiler activation command, COBOL 
<filename>. The format of the entry consists of following 
<filename> by one space and then entering a followed 

immediately by the desired toggles. There must be only one 
space after <filename> and no spaces between the and the 

toggles. The following is an example of a typical entry: 
COBOL EXAMPLE $ST 

This entry would cause the compiler to ignore the sequence 
numbers entered at the beginning of each input file line and 
print the token numbers to the output device. In each case 
the toggle reverses the default value. 

$L — list the input code on the screen as the program 
is compiled. Default is on. Error messages will be difficult 
to understand if this toggle is turned off, but if the 
interface device is a teletype, it may be desired in certain 
situations. 

$S — sequence numbers are in the first six positions of 
each record. Default is off. 

— list productions as they occur. Default is off. 

$T — list tokens from the scanner. Default is off. 
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IV. RUN TIMS CONVENTIONS 



This section explains how to run the compiler on the 
current system. The compiler expects to see a file with a 
type of C3L as the input file. In general, the input is free 
form. If the input includes sequence numbers then the 
compiler must be notified by setting the appropriate toggle. 
The compiler is started by typing COBOL <file-name>. Where 
the file name is the system name of the input file. There is 
no interaction required to start the second part of the 
compiler. The output file will have the same <file-name> as 
the input file, and will be given a file type of CIN. Any 
previous copies of the file will be erased. 

The interpreter is started by typing EXEC <filename>. 
The first program is a loader, and it will display "LOAE 
FINISHED ' to indicate successful completion. The run-time 
package will be brought in by the INTRDR routine, and 
execution should continue without interuption. 



12S 



V . FILE INTERACTIONS WITH C?/M 



The file structure that is expected by the program 
imposes some restrictions on the system. References 4 and 5 
contain detailed information on the facilities of CP/M, and 
should be consulted for details. The information that has 
been included in this section is intended to explain where 
limitations exist and how the program interacts with the 
system. 

All files in CP/M are on a random access device, and 
there is no way for the system to distinguish sequential 
files from files created in a random mode. This means that 
the various types of reads and writes are all valid to any 
file that has fixed length records. The restrictions of the 
ASSIGN statement do prevent a file from being open for both 
random and sequential actions during one program. 

Each logical record is terminated by a carriage return 
and a line feed. In the case of variable length records, 
this is the only end mark that exists. This convention was 
adopted to allow the various programs which are used in CP/M 
to work with the files. Files created by the editor, for 
example, will generally be variable length files. This 
convention does remove the capability of reading variable 
length files in a random mode. 

All of the physical records are 123 bytes in length, and 
the program supplies buffer space for these records in 
addition to the logical records. Logical records may be of 
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any desired length. 



133 



VI. 5FP.0R MESSAGES 



A. COMPILER FATAL MESSAGES 

ER Ead read — disk error, no corrective action can be 
taken in the program. 

CL Close error — unable to close the output file. 

MA Make error — could not create the output file. 

MO Memory overflow — the code and constants generated 

will not fit in the alloted memory space. 

OP Open error — can not o^en the input file, or no such 
file present. 

SO Stack overflow — the LALR(l) parsing stack has exceeded 
its maximum allowable size. 

ST Symbol table overflow — symbol table is toe large for 
the allocated space. 

VIR Write error — disk error, could not write a code 

record to the disk. 

3. COMPILER WARNINGS 

CE Close error — attempted to close a non-existing file. 

DC Decimal count error — decimal significance is sreater 
than 18 digits . 

DI Duplicate identifier — the identifier name has been 
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previously declared in the WORKING STORAGE area of the 
pr ogram . 

EF Excess files — the number of files declared in the 
source program exceeds 24. 

EL Extra levels — only 10 levels are allowed. 

FT File type — the data element used in a read or write 

statement is not a file name. 

IA Invalid access — the specified options are not an 
allowable combination. 

ID Identifier stack overflow — more than 20 items in a 
GO TO — DEPENDING statement. 

IS Invalid subscript — an item was subscripted but it 

was not defined by an OCCURS. 

IT Invalid type — the field types do not match for this 

statement . 

LE Literal error — a literal value was assigned to an 

item that is part of a group item previously assigned 
a value. 

LV Literal value error — the PICTURE clause field type 
does not match the VALUE clause literal type. 

MD Multiple decimals — a numeric literal in a VALUE 
clause contains more than one decimal point. 

MS Multiple signs — a signed numeric literal in a VALUE 
clause contains more than one sign. 

NF No file assigned — there was no SELECT clause for 

this file. 
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N I Not implemented — a production was used that is not 
implemen ted . 

NN Non-numeric — an invalid character was found in a 

numeric string. 

NP No production — no production exists for the cuurrent 
parser configuration! error recovery will automatically 
occur. 

NV Numeric value — a numeric value was assigned to a 

non-numeric item. 

OE Open error — attempt to open a file that was not de- 
clared; or attempted to open a file for 1-0 that was 
not a RELATIVE file. 

PC Picture clause — an invalid character or set of 
characters exists in the picture clause. 

PE Paragraph first — a section header was produced after 
a paragraph header, which is not in a section. 

R1 Redefine nesting — a redefinition was made for an 
item which is part of a redefined item. 

R2 Redefine length — the length of the redefinition item 
was greater than the item that it redefined. This error 
message may he printed out one identifier past the 
redefining identifier record in which it occurred. 

R3 Redefines misplaced — a redefines was attempted in the 
FILE SECTION of the source program. 

SE Scanner error — the scanner was unable to read an 

identifier due to an invalid character. 

SG Sign error — either a sign was expected and not 
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found, or a sien was present when not valid. 

SL Significance loss — the number assigned as a value is 
larger than the field defined. 

Tel Type error — the type of a subscript index is not 
integer numeric. 

UI Undeclared identifier — the identifier was not 

declared in WORKING STORAGE area of the source program. 

VE Value error — a value statement was assigned to an 
item in the file section. 

WL Wrong level error — program attempted to write a 
record other than an 01 level record to an output 
file. 

C. INTERPRETER FATAL ERRORS 

CL Close error — the system was unable to close an output 
file. 

ME Make error — the system was unable to make an input 
file on the disk. 

NF No file — an input file could not be opened. 

W1 Write no n-sequent ia 1 — attempted to WRITE to a file 
opened for INPUT or a file opened for 1-0 when ACCESS 
was SEQUENTIAL. 

W2 Wrong key — attempted to change the key value to a 
lower value than the number of the last record writ- 
ten . 
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V 3 Write input — attempted to WRITE to a file opened 

for INPUT. 

W4 Write non-empty — attempted to WRITE to a non-empty 
record . 

W5 Read output — attempted to READ a file opened for 
OUTPUT. 

W6 Rewrite error — attempted to REWRITE to a file 
not opened fo 1-0 . 

W7 Rewrite error — attempted to REWRITE a record before 
reading the file; or multiple REWRITE attempts with- 
out doing a READ between each. 

D. INTERPRETER WARNING MESSAGES 

EM End mars — a record that was read did not have a 

carriage return or a line feed in the expected location. 

GD Go to depending — the value of the depending indicator 
was greater than the number of available branch 
addresse s . 

IC Invalid character — an invalid character was loaded 

into an output field during an edited move. For example, 
a numeric character into an alphabetic-only 
field. 

SI Sign Invalid — the sign is not a " +” or a 

WE Write Error — attempted to write to an output file. 
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APPENDIX 3 



LIST OF MICRO-COBOL RESERVED WORDS 



The following is a list of reserved words for 

MICRO-COBOL. The reserved words are the same as those 
specified for the HYP0-C030L language, except where noted 
with an asterisk (*) . 



ACCEPT 


ENVIRONMENT 


MULTIPLY 


RUN 


ACCESS 


EOF * 


NEXT 


S AME 


ADD 


ECUAL 


NOT 


SECTION 


ADVANCING 


ERROR 


NUMERIC 


SECURITY 


AFTER 


EXIT 


OBJECT-COMPUTER 


SELECT 


ALPHABETIC 


FD 


OCCURS 


SENTENCE 


ASSIGN 


FILE 


OF 


SEPARATE 


AUTHOR 


FILE-CONTROL 


OMITTED 


SEOUENTI AL 


BEFORE 


FILLER 


OPEN 


SIGN 


BLOCK 


FROM 


ORGANIZATION 


SIZE 


BY 


GO 


OUTPUT 


SOURCE-COMPUTER 


CALL 


GREATER 


PAGE 


SPACE 


CLOSE 


1-0 


PERFORM 


STANDARD 


COBOL 


1-0 -CONTROL 


PIC 


STOP 


COMP 


IDENTIFICATION 


PROCEDURE 


SUBTRACT 


CONFIGURATION 


IF 


PROGRAM 


SYNC 


DATA 


INPUT 


PROGRAM-ID 


THRU 


DATE-WRITTEN 


INPUT-OUTPUT 


QUOTE 


TIMES 


DEBUGGING 


INVALID 


RANDOM 


TO 


DELETE 


INTO 


READ 


TRAILING 


DEPENDING 


LABEL 


RECORD 


UNTIL 


DISPLAY 


LEADING 


RECORDS 


USAGE 


DIVIDE 


LEFT 


REDEFINES 


USING 


DIVISION 


LESS 


RELATIVE 


VALUE 


ELSE 


LINKAGE 


REWRITE 


WORKING-STORAGE 


END 


MODE 


RIGHT 


WRITE 


ENTER 


MOVE 


ROUNDED 


ZERO 
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APPENDIX C 



The MICRO-COEOL compiler and interpreter source files 
currently exist in the high level language PLM80 and are 
edited and compiled under the ISIS operating system on a 
INTEL Corporation MDS system. This is a description of the 
procedures reauired to compile and establish the programs to 
compile and interpret a MICRO-COBOL program. The MICRO-COBOL 
compiler and interpreter run on any 8080 or Z-80 based 
microcomputer that operates under CP/M. The execution of the 
following four files will cause a MICRO-COBOL program to be 
compiled and executed: 

1. COBOL.COM 

2. PAET2.COM 

3. EXEC.COM 

\ 

4. CINTERP.COM 

These four files are created from the following six 
PLM80 source programs. 



1 . 


PARTI .PLM 




2. 


PART2 . PLM 




3. 


BUILD .PLM 




4 . 


IREADER .PLM 




5. 


INTRDR.PLM 




6. 


INTER? .PLM 




The 


procedures used to 


create the four object files (COM 


es ) 


involve compiling. 


linking, and locating each of the 
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six source files under ISIS. The SID program is then used 
under CP/M to construct the executable files. Each of the 
following steps describe the action(s) to be taken and, 
where appropriate, the command string to be entered into the 
computer . 

1. An ISIS system disk containing the PLM80 compiler is 
placed into drive A and a non-system disk containing the 
source programs is placed into drive 5. It should be noted 
that drive A and B are the CP/M reference names for the 
drives while FI and F2 are the ISIS reference names used for 
the associated disk drives. 

2. Compile the PLM source program under ISIS using the 
the following command: 

PLM80 :F1 :<f ilename>.PLM DOUG XRZF 

DEBUG saves the symbol table and line files for later 
use during debugging sessions. XR3? causes a cross-reference 
listing, of all identifiers in the source program, to be 
created. The cross-reference listing includes each 
identifier and the associated line number where the 
identifer was declared and the line number of each occurence 
of the identifier in the source program [9]. 

3. Link the PLM80 object file. 

LINK : FI : <f i lename> .OBJ . TRINT.OBJ. PLM80.LI3, TO 

:Fl:<filename>.MOD 

See reference 10 for an explanation of PLM60.LIB. The 
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TRINT.OBJ program interfaces the MON1 and M0N2 functions of 
CP/M to the source program, allowing for the use of absolute 
addresses in referencing these functions. 

4. Locate the object file. 

LOCATE :F1 :<filename>.MOD CODE(org address) 

The ”org address’ is the address where the program will 
begin to be loaded into memory. The following are "org 
addresses’ for the associated program: 



PARTI .MOD 


100H 


PART 2. MOD 


100H 


I NTERP . MOD 


100H 


INTRDR. MOD 


80H 


BUILD. MOD 


100H 


IREADER. MOD 


D000H 



The ’’org addresses" above represent the ones used with a 621 
byte CP/M system. The only address that would need to be 
changed if a different size system was used would be the one 
for I HEADER. MOD. See appendix E for specifics on the address 
to use for IREADER. 

4a. The two files INTRDR and IREADER just created by the 
LOCATE command must be converted to "HEX FILES". 3y using 
the ISIS command OBJHEX <filename> the file will be 
converted to the "HEX file" <f i 1 ename > . HEX . 

5. Replace the ISIS system disk in drive A with a CP/M 
system disk and reboot the system. 
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6. Transfer the located ISIS file from the ISIS disk on 
drive 3 to the CP/M disk on drive A. 

FROMISIS <?ilename> 

6a. When transfering the "HEX files" to the CP/M disk 
use the following: 

FROMISIS <f i lename> .HEX 

7. Convert the ISIS file to a C?/M executable form. 

OB JC PM <filename> 

7a. The "HEX files" are not coverted to a CP/M format, 
hut are left in the HEX format. 

At this point the object file is in machine readable 
form and will run under CP/M when called properly. PART2.COM 
and CINTERP.COM are called by PART1.COM (COBOL.COM) and 
EXEC.COM, respectively and need no further work. PART1.COM 
and EXEC.COM need to be constructed from the remaining four 
files . 

PART1.COM is created by entering the following commands: 

1. SID PART1.COM 

2. I READER. HEX 

3. R6200 

4. A2A9A 

5. JMP 0D000 

6. Control-C 

7. Save 52 COBOL.COM 
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and 



See reference 6 for an explanation of the I ’, 

"a” commands used above and ref 4 for an explanation of the 
’SAVE* command. Steps four and five above are used to patch 
the JUMP to IREADER referred to in the PARTI. PLM program 
into the PART1.COM program. 

EXEC.COM us created by entering the following commands: 

1. SID BUILD.COM 

2. INTRDR .HEX 

3. R1C00 

4. A1CB5 

5. JMP 5 

6. A1CC1 

7. JMP 5 

8. CONTROL-C 

9. SAVE 31 EXEC.COM 

Statements 4, 5, 6, and 7 above are used to patch the 

JUMP to BDOS referred to in the INTRDR. PLM program into the 
INTRDR. HEX program. 

NPS MICRO-COBOL programs may now be executed in the 
following manner. The source program is named, 

<f i lename> . C3L . The command "COBOL <f ilenameV' , causes the 
MICRO-COBOL source program to be read into memory and 
compiled. During the compilation, the intermediate code 
file, <f ilename> . C IN , is written out to the disk as the code 
is generated. The command 'EXEC <filename>", causes the 
file, <f i lenameb . C I N , to be executed. 
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APPENDIX D 



PART ONE AND PART TWO INTERNAL DATA STRUCTURES 
AND SIGNIFICANT VARIABLES 

Within PART ONE and PART TWO, many significant data 
structures are used hy the procedures which constitute the 
scanner and parser. Descriptions are given below for those 
structures regarded as important and necessary for future 
compiler development. 

1. Interfacing Structures 

ADD^END — this variable is used to hold the end of 
file filler for the end of the source program. 

BUFTER(ll) — byte array used to hold the filename 
and filetype if declared, of an input or output file in the 
SELECT CLAUSE of the FILE SECTION of a MICR0-C030L source 
program . 

3UFFER^END — address variable which marks the last 
byte of the compiler input buffer which is a 128 byte buffer 
used for reading the source program. 

IN$ADDR — address variable, default file control 
block used initially to hold the <f ilename . C3L> of the 
source program to be compiled. 

IN$BUFF — literal value, marks the first byte of 
the compiler input buffer. 

INPUT^FCB — byte value, based at IN$ADDR(33), the 
base address of the default file control block of the source 
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program . 

OUTPUT$PUFF( 128 ) — byte array, used as a 128 byte 
output buffer for loading the generated output (pseudo 
instructions) when writing to the intermediate code file. 

OUTPUT$CHAR — byte value, based at the OUTPUT$PT?.J 
used to identify the particular byte of the output buffer 
(OUTPUT$BUFF ) to which the next intermediate code 
instruction is to be written. 

OUTPUT^END — address variable, pointer to the end 
of the output buffer (OUTPUT$BUF? ) . 

0UTPUT$FC3(33 ) — byte array, the FCB for the 
intermediate code file <filename ,CIN> established in PART 
ONE of the compiler and pasted to PART TWO of the compiler 
by IREADER module. 

0UT?UT$PTR — address value, used as an index into 
the output buffer (OUTPUT$BUFF) . 

POINTER — address value, the address of the byte 
holding the next input character of the source program. 

2. Debugging Structures 

DEBUGGING — logical byte value, toggle used in 
conjunction with in a MICRO-COBOL source program text; 
allows for the compilation or non-compilation of the 
deugging statements following the 

LIST$INPUT — logical byte value, toggle used to 
display or not display a source program to the CRT during 
compi lat ion . 
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PARMLIST(9) — byte array used to hold the toggles 
set by the compiler developer or user upon execution of the 
command: COBOL <f i lename . CBL> ^TOGGLES . 

PRIMT$PROD — logical byte value, toggle used to 
print, in chronological order, at the CRT the production 
numbers of the compiler grammar rules used during a 
compilation of the source program. 

SEO^NUM — logical byte value, toggle used to 
indicate the presence of sequence numbers in the first six 
positions of each line of a source program being compiled. 

3. Memory Structures 

EOEFILLER — literal value, used to test for the 
occurrence of an end of file character ("lAH” in CP/M), when 
reading the source program. 

EREE$STCRAGE — first free address following PART 
ONE of the compiler? utilized as the base of the symbol 
table. This is the same value as EASH$TA3iADDR in PART TWO 
of the compiler. 

IN ITI AL^PCS — address value, the initial location 
of the IREADER module before it is copied to high memory at 
location MAX$MEMORY . 

MAX^MEMORY — address value, the location in high 
memory where the IREADER module is to be moved. 

NEXT$ A VA. I LABLE — address value, the pseudo machine 
memory address for the next machine instruction. 

PARTliLEN — the number of bytes of information 
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saved in high memory after execution of PART ONE and used to 
initialize PART TWO module variables of the compiler. 

PASS1$T0P — this address is used in conjunction 
with ?ASS1$LEN for locating the fourty-eight bytes of 
information saved in PART ONE for use in PART TWO of the 
compi ler . 

?DR$LENGTH — literal value representing the 255 
bytes of the IREADER module to be moved from iNlTIALiPOS to 
MAX$MEMORY . 

4. Scanner Structures: 

ACCUM(51) — an array of 51 bytes; the first byte 
contains a count of the total number of characters currently 
in the accumulator. This structure holds tokens as they are 
scanned, and will hold either a reserved word, a user 
defined identifier, or a literal. 

COLLISION — address varible, contained in first two 
bytes of an identifier's symbol table entry and indicates 
whether there is another identifier which hashes to the same 
hash table address. This address points to that identifier's 
address in the symbol table. 

DISPLAY(74) — an array of 74 bytes? the first byte 
contains a count of the total number of characters (1-73) 
currently in the display buffer. Every line within a source 
program is loaded into this structure for subsequent 
printing to the CRT terminal during compilation. 

EBIT^ELAG- — logical flag which denotes the fact 
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that a symbol has been loaded into the DISPLAY array 
during compilation. When set the characters within DISPLAY 
will be printed one at a time, until the entire line is 
printed . 

HASH$TABLE$ADDR — the base of the symbol table 
generated in PART ONE, used as the base of the hashtable. 

HASH^TABi ADDR — this was the address of the bottom 
of the symbol table generated in PART ONE of the compiler, 
and saved for Part two. 

INPUT$STR — literal value (32), returned to the 
LALR(l) parser anytime the token contained in the ACCUM is 
not a reserved word or literal. 





LITERAL 


literal 


value (15), returned to 


the 


LALR(l) 


parser 


anytime t 


he first character encountered by 


the scan 


ner is a 


quote ('), 


prior to loading the ACCUM. 






MAX$LEN 


length 


of the longest reserved 


word 



allowed by MICRO-COBOL. 

5. Parser Structures: 

BUEFER(31) — byte array used to store edited 
PICTURE CLAUSE characters for subsequent intermediated code 
generation. 

COMPILING — logical byte value which indicates that 
compiling is taking place or not in PART ONE or PART TWO; 
set to FALSE whenever the statestack of the LALR(l) parser 
is reduced to a recognizable finished state. 

CURiSYM — address variable that holds the address 
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of the current symbol being accessed in the symbol table. 



DUP$IDEN$ARRAY ( 24 ) — address array that holds the 
symbol address for all files declared in the INPUT-OUTPUT 
SECTION of a source program. When the FILE SECTION entry for 
the file is encountered the array is searched to determine 
if the file was declared and to insure that a FILE SECTION 
entry had not been previously made. 

FILE$DESC$FLAG — logical byte value; indicates 
whether the compiler is compiling the FILE DESCRIPTION 
SECTION of a source program or not. 

FILE$SEC$END — logical byte value set whenever the 
parser has parsed passed the FILE SECTION of a source 
program. 

E0LD$LIT(51) — byte array, first byte contains a 
count of the total number of characters currently stored in 
the HOLDLIT buffer which is used to hold characters for a 
VALUE CLAUSE. 

ID$STACE(10) — address array which functions as a 
stack and is used to hold the addresses of identifiers at 
both the record and elementary levels. Whenever a record 
identifier has nested elementary field identifiers it is 
saved on the ID^STACK. Also, anytime a record identifier has 
succeeding record identifiers redefining it, it is saved on 
the ID$STACX. In the case of multiple record descriptions in 
a file description of the FILE SECTION, the record 
descriptions following the first record are assumed 
redef ini tions . 
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IDiSTACX$?TR — a byte index variable into the 
ID$STACK array. 

MAX$ID^LEN — a numeric value (12), maximum length 
of any user defined identifier. 

MP — byte index variable into the VAL'JS array. 

MPP1 -- byte index variable into the VALUE array, 
one byte above MP index. 

NEXT$SYM — this address indicates the next 

available free space for a symbol table entry. 

PENDING$LITERAL — byte value ( 0 , 1 , 2 , 3 ,4 , 5 ) , 

indicates the category of the target input to a VALUE 
CLAUSE. 

PENDI NG$LIT$ ID — byte value (0 , 1 , 2, 3 ,4 , 5) , which is 
saved to indicate the category of the most recently 
encountered target input to a VALUE CLAUSE. 

PRODUCTION — byte value, determined by the parser 
and indicates the next semantic action to be taken by the 
compiler. 

REDEE — logical byte value which allows the testing 
of an identifier's storage value size against the storage 
value size of a second identifier that redefines the first. 
Set to TRUE when there are multiple record descriptions 
within a FD BLOCK in the FILE SECTION, or when a record or 
elementary identifier declaration in the WORKING STORAGE 
SECTION contains a REDEFINES CLAUSE. 

REDEF$FLAG — logical byte value, used to denote the 
scanning and parsing of the FILE SECTION of a source 
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program, helps in identifying duplicate identifiers within 
this section. 

REDEF$ONE — address variable that holds the symbol 
table address of the identifier being redefined by another 
identifier. 

REDEF$TWO — an address variable that contains the 
symbol table address of an identifier which redefines 
another identifier. 

S? — a byte index for the STAT3STACK array and the 
VALUE array? points to the top of the STATESTACK array. 

STATE — a byte value numeric quantity that 
indicates the current parser state. 

STATESTACK (30 ) — a byte array which stacks the 
states (production sequences) the parser passes through 
while compiling a source program. 

TF.UNC$FLAG — logical byte value that indicates 
numeric truncation of an identifier's VALUE CLAUSE input 
hasn't occurred, because the identifier's associated PICTUFE 
CLAUSE has not been scanned and parsed. 

VA LUE ( 30 ) — an address array that holds addresses 
of identifiers, specific attributes of these identifiers and 
attributes of the current source program statement or 
sentence being parsed. 

VARC(51) — a byte array, the first byte holds the 
count of the total number of characters within it, used to 
hold all the ASCII characters of tokens scanned within the 
source program, excluding reserved words; for subsequent 
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VALUE CLAUSE or when a record 
no associated PICTURE CLAUS 
elementary field identifiers. 

VALUES LEVEL -- a byte 
number of a record identi 
associated PICTURE CLAUSE. 



anytime an 

y to 

CLAUSE before the 
UE CLAUSE, but 
those in its 



value 


which 


saves 


the level 


fier 


which 


doesn 


't have an 



analysis and processing. 

VALUEiELAG — a logical byte that is set 
identifier has an associated VALUE CLAUSE; used primaril 
recognize the occurrence of a PICTURE 

entry has a VAL 
E except for 
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APPENDIX E 



The NPS MICRO-COBOL compiler/interpreter is designed, to 
operate on any 8080 or Z80 based microcomputer operating 
under CP/M with at least 20X bytes of memory. The PLM80 
source files have been written in such a way, that certain 
variables must be altered in the source code to take 
advantage of the machine that the programs are going to be 
operating on. This appendix covers those programs and the 
variables that must be altered. 

1. PART1.PLM 

This program has two variables that are memory size 
dependent, MAXiMEMORY and M.«X$INT$MEMOF.Y . The variable 
MAX^MEMORY is set to 100H bytes below the base of the 3D0S 
and is used for the beginning address of the IREADER 
routine. The variable MAX$ INT^MEMORY is set to the base 
address of the BDOS and is used as the upper limit for the 
intermediate code file. 

2. PART2.PLM 

This program also has two variables that are memory size 
dependent, MAX^MEMORY and PASSliTOP. In this program 
MAX $MEMORY is set to the base address of the BDOS while 
?ASS1$T0P is set to 130H bytes below the base of the 3DCS . 

3. IREADER .PLM 

Although, this program does not have any memory size 
dependent variables the program must be modified to execute 
properly. When using the LOCATE command, under ISIS, this 
routine must be located 100H bytes below the 3DCS of the 
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system. This address would correspond to the values of 
MAX$MEMORY in PART2.PLM and MAX$ INTiMEMORT in PARTI. PLM. 

4. INTERP.PLM, INTRDR.PLM, and BUILD. PLM 

These three programs have no variables that need to be 
altered. 

5. GENERAL I NEORMAT ION 

The current version of the NPS MICRO-COBOL 

compiler/interpreter is designed for continued development 
and certain variables are not set to make optimal use of 
memory. The variable NEXT$AVA ILA3LE , in PARTI. PLM, is set to 
3002E and COUE$START, in INTER?. PLM, is set to 3000H. 
Normally, COES$START would be set to the address immediately 
following the last address in CINTERP.COM and NPXT$ AVAILABLE 
would be set two bytes above that address. These address are 
currently set approximately 950E bytes above where they 
should be located, to allow for testing and expansion of the 
interpreter. As soon as implementation is completed these 
two addresses can be reset to appropriate values. 
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APPENDIX F 



MICRO-COBOL Parse Table Generation 

The parse tables for NPS Mlcro-Cobol were generated on 
the IBM 360 using the LALR(l) parse table generater 
described in reference 17. There are basically two steps 
involved in generating the tables. First, a deck of cards 
containing the grammar is entered into the computer using 
the following JCL: 

//GO EXEC ?GM= ULR ,REGION=220K 
//STEPLIB DD DSN=F0963 . LALR , UN IT=231 4 , 

VOL=SER=LlNDA ,DISP=SHR 
//SYSPRINT DD SYSOUT=A, DCB=(RSCFM=FB , 

LRECL=133 , 3LKS I ZE=3325 ) , 

//SPACE=(CTL,(1,1)) 

//NONTERM DD SPACE= (CYL , ( 1 ,1 ) ) ,UN I T=SYSDA 
//FSMDATA DD S?ACE=(CYL, ( 1,1) ) , UN I T=S YSDA 
//PTABLES DD SYSOUT=B, 

DCB= (?ECFM=FB ,LRECL=80 , 3LXS I ZS=300 ) 

//SYSIN DD * 

The ouput from this run is a listing and a card deck 
containing the tables in XPL compatable format. This deck is 
then translated into PLM compatible format using the 
following JCL and an XPL urogram which is available in the 
card deck library in the Computer Science Department at the 
Naval Postgraduate School. 

//EXEC XCOM 
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/ 



//COMP . SYS I N DD * 

//GO .SYSPUNCH DD SYS0UT=3, 

DC3= (RECFM=FB ,LRECL=80 , 3LKS I ZE=800 ) 
//GO.SYSIN DD * 

The tables are then transferred to a diskette 
into the PLM80 source program using the ISIS COPY 
features on the INTEL MDS System. 



and edited 
and EDIT 
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APPENDIX G 



LIST OF INOPERATIVE CONSTRUCTS 



The following is a list of MICRO-COBOL elements that 
either have not been implemented or have been implemented 
incorrectly. 

LINKAGE SECTION 
USAGE COMP 

{LEADING} 

SIGN SEPARATE 

{TRAILING} 

{LEFT} 

SYNC 

{RIGHT} 

ADD 



DI7IDE 



DELETE 

EXIT 

MOVE 

MULTIPLY 
SU3TRACT 
The fol 
MI CR0-CC30L o 
grammar. No c 



ovi 


r.g 


EYP0-C030L 


elements are part of 


iy 


t 0 


the extent 


tnat they are defined in the 


de 


has 


been writ 


ten 


to support them. 



USING 

CALL 



ENTER 
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{ BEFORE } 

WHITE record-nane ADVANCING 

{AFTER} 



{INTEGER} 

{PAGE} 



1 56 



COMPUTER LISTINGS 



PARTI : 








do; 








/* NORMALLY ORG'ED 


AT 1 00H */ 




/* COBOL 


COMPILER - PART 1 


j- / 


/* GLOBAL DECLARATIONS AND LITERALS */ 


DECLARE LIT LITERALLY ' 


LITERALLY'; 




DECLARE 








PARMS 


LIT 


'6DH ' , 




PA RMLI ST ( 9 ) 


BYTE 


INITIAL! 


'), 


EOEFILLER 


LIT 


' 1AH ' , 








/* END OF 


RECORD FILLER 


MAXi MEMORY 


LIT 


'0D000H ' , 








/* TOP OF 


USEABLE MEMORY 


I NITI AL$POS 


LIT 


'3230H', 




RDRi LENGTH 


LIT 


'255', 




PASS 1$LEN 


LIT 


'48', 




CR 


LIT 


'13', 




LF 


LIT 


'10', 




QUOTE 


LIT 


' 27 H ' , 




POUND 


LIT 


'23H ' , 




TRUE 


LIT 


'1', 




FALSE 


LIT 


O', 




?ILE$DESC$FLAG 




BYTE 


INITIAL (FALSE ) 


REDEF$FLAG 




BYTE 


INITIAL! FALSE ) 


DUP^ IDEN$ ARRAY ( 24 ) 


ADDRESS 




INITIAL(0,0,0,0,0,; 


0,0,0 


f 0 , 0 , 0 » 0 , 3 f 0 »0? 


0,0, 0,0, 0,0,0, 


FOREVER 


LIT 


'WHILE TRUE'; 


DECLARE MAXRNO LIT 




'104',/* MAX 


READ COUNT */ 


MAXLNO LIT 




'129',/* MAX 


LOOK COUNT */ 


MAXPNO LIT 




'145',/* MAX 


PUSH COUNT */ 


MAXSNO LIT 




'234',/* MAX 


STATE COUNT */ 


STARTS LIT 




'1 ';/* START 


STATE */ 



♦ 

DECLARE RSAD1 (*) 3TTE 

DAT A(0, 57,48,56,32,8,25,59,2, 16, 1? ,22 ,29,53,58, 11,32,32,39 
,38 ,34, 44,9, 19, 32, 37, 6, 33, 3, 14, 15, 18, 20, 32, 23, 49, 32, 1,42 
,38,36,43,1,1,1,1,1,1,1,1,1,10,1,39,1,1,1,38,40,49,38,39,1 
,1 ,38,23 ,24,55 ,52,41 , 35 , 46 , 1 , 7 , 50 , 1 , 32 , 1 , 32 , 32 , 45 

,1 ,32,1 ,32,1 ,32,47,37,4 ,26,32 ,54,40 ,1 ,1 
,32,5,12,13,21,22,27,1,60,1,23,24,55,30,51); 

DECLARE L00K1 ( *) BYTE 

DA TA( 0,8, 0,25, 0,9, 19, 0,42, 0,42,0,1 ,0,52,0,41 ,0,35,0,1 ,0,47 
,0,4,0,54,0,40,0,35,46,60,0,1,0,32,0,1,0,1,0,11,0,60,0,7,0 
32,0,32,0,32,0); 

DECLARE APPLYlf*) BYTE 

DATA( 0,0, 0,0,0 ,0,9,10,12, 14, 19,0,0,0,0,0,0,101,0,0, 100,0 
,0,0,0,0,0,97,0,27,0,0,0,69,0,91,92,0,0,91,92,0,0,0.0,13 
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,17,0,102 ,103, 104, 0,0, 0,0, 0,95, 0,0, 54, 0,0, 23, 30, 38, 39,0 

,21,40,52,56,87,93,94,0); 

DECLARE READ2 ( * ) BITE 

DATA (0,65, 57, 64, 154, 26, 37 ,67,21 ,30 ,31 ,33 ,39 ,61 , 66 , 27 , 234 
,215,51,45,108,109,223,224,233,43,216,217,22,230,229,232 
,231,228,173 ,172,169,9,226,47,196,195,7,8,11,13,15,2,3,105 

,14,158,4,50 ,20,12 ,18 ,48 , 171 , 170 , 44 ,49 , 19 , 10 , 46 ,35 ,36 

,63,60,53,42,146,16,25, 58, 106,155 ,148,155,155,55,150,155 

,152,155,157,155,56,193,23,208,234,62,52,206 
,180,234 ,24,28,107,32,34,38,17,63,164,35,36,63,40,59) J 
DECLARE LOOK2 ( * ) BYTE 

DATA( 0,5, 130, 6, 131, 29, 29, 132, 41, 133, 54, 134, 135, 69, 71, 136 
,72,137,73,138,139,80,84,140,86,198,88,141 ,39,142184,184 
,184,91,189 ,92,93,197,211,95,143,96,97,176,99,144,145,101 

,102,200,103,202,104,188) ; 

DECLARE APPLY2 (*) BYTE 

DATA (0,0, 77, 11 1,112, 147, 79, 114, 81, 82, 33, 79, 76, 117, 75, 156 
,126,163,162,100,166,165,167,118,168,160,124,179,178,94 
,121,74,125 ,120,119,187,187,186 ,98 , 192 ,192 , 191 , 194 , 113 

,183,128,129,127,205,205 ,205,204,115,123,90,122,214,213,221 
,219,218,222,199,85,220 ,116,87 ,110,70,174,209,207,182 

,182,181); 

DECLARE INDEXK*) BYTE 

DAT A (0,1 ,2,3,4,5,6,7,8,4,4,24,4,24,4,13,14,24.109,4,15,16 
,16,24,17,18,19,16,20 ,22,24,25,26,28,29,34,36,37,24,24,16 
,38,39,40 ,42,43,44,45,46,47.48,49, 16,50,38,51,16,52,53,54 

,55,56,57,58,60,61 ,62,63,64,8,65,68,69,70 ,71 ,72,73,74,75,77 
,79,81 ,83,85,87,88,89,90,92 ,93 , 94 , 8 ,8 , 16 , 95 ,97 , 97 , 15 , 103 

,104, 105,109,24,24,24,1,3,5,8,10 ,12,14 ,16,18,20,22,24,26,28 
,30,34,36,38,40,42,44,46,48,50,52,185,149,225 
,227,227 ,190,151 

,153,203,159,210,161,175,212,201.177,1,2,3,3,4,4,5,5 ,6,6,12 
,13,14,14,15,15,16,16,17,19,19,20,20,20 ,22,22,23,23,24,24,25 
,25,26,26,27,29,29,31,32,32,33,33,35,38,36,33,33,39,39,39 
,39,39,42 ,42,43,43,44,44,45,45,48,52,52,53,53,54,54,55,55 

,56,56.56,56,56,56 ,56,56,58,58,58,59,59,61,61,61,61,61 

,62,67); 

DECLARE INDEX2 (* ) BYTE 

DATA (0,1, 1,1, 1,1 ,1,1, 5, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1,1 
,1,1, 2, 2, 1,1, 2, 1,5, 2, 1,1, 1,1, 1,1, 1,2, 1,1, 1,1, 1,1, 1,1, 1,1,1 
,1,1, 1,1,1 ,1, 1,1, 2, 1,1, 1,1, 1,5, 3, 1,1, 1,1, 1,1, 1,2, 2, 2, 2, 2, 2 

,1,1, 1,2,1, 1,1, 5, 5,1 ,2, 6, 6, 1,1, 1,4, 2, 1,1, 1,2, 2, 3, 2, 2, 2, 2 

,2, 2, 2, 2, 2, 2, 2, 4, 2, 2, 2, 2, 2, 2, 2, 2 ,2, 2, 5, 6, 29 ,41, 54, 69, 71, 72 
,73,80,84,88,89,96,99,101,3,9,3,0,3,0,3,0 ,0,1, 7, 8, 1,0, 6,0 

,0,1, 3, 0,1, 1,2, 1,0, 0,0, 0,1, 0,2, 0,3, 1,2, 0,1, 5, 3, 0,0,1 ,4,0,0 

,0,1, 2, 1,2, 2, 2, 0,2, 3, 0,3, 0,0,1, 4, 0,0, 1,0,0, 0,0, 1,1, 1,1, 2, 2,1 
,1,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0) ; /* END CE TABLES */ 

DECLARE 

/* JOINT DECLARATIONS 

THESE ITEMS ARE DECLARED TOGETHER IN THIS SECTION 
IN ORDER TO FACILITATE THEIR BEING SAVED FOR 
THE SECOND PART OF THE COMPILER. */ 

OUTPUT$FCB (33) BYTE 
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INITIALS, ' 


', 'CIN 


i', 0,0.0. 


0). 


DEBUGGING 


BYTE 


INITIAL 


(FALSE) , 


PRI NT^PROD 


BYTE 


INITIAL( FALSE) , 


PRI NT$TOKEN 


BYTE 


I N I T I A L ( FALSE ) , 


LIST$INPUT 


BYTE 


INITIAL 


(TRUE) , 


SEO^NUM 


BYTE 


INITIAL 


(FALSE) , 


NEXT $SYM 


ADDRESS, 






POINTER 


ADDRESS 


INITIAL 


( 100H ) , 


NEXT $AVAIL ABLE 


ADDRESS 


INITIAL 


( 3002H ) , 


MAX$INT$MSM 


ADDRESS 


INITIAL 


(0D100H) , 


FREE$STORAGE 


ADDRESS , 






FILE$SEC$END 


BYTE 


INITIAL 


(FALSE) , 



/* I 0 BUFFERS AND GLOBALS */ 
IN$ADDR ADDRESS INITIAL ( 5CH ) , 

I NPUT$FCB BASED INADDR (33) BYTE, 
OUT?UT$PTR ADDRESS , 

OUTPUT^BUFF (128) BYTE, 

OUTPUTS END ADDRESS, 

OUTPUT^ CHAR BASED OOTPUT$PTR 3YTE > 



MON1: PROCEDURE (F, A) EXTERNAL; 

DECLARE A ADDRESS, F BYTE? 

END MONIJ 

M0N2: PROCEDURE (7, A) BYTE EXTERNAL; 

DECLARE F BYTE, A ADDRESS; 

END M0N2J 

BOOT: PROCEDURE EXTERNAL; 

DECLARE A ADDRESS; 

END boot; 

PRINTCHAR: PROCEDURE (CHAR); 

DECLARE CHAR BYTE? 

CALL MON1 (2, CHAR); 

END PRINTCHAR,* 

CRLF : PROCEDURE? 

CALL PRINTCHAR (CR) ; 

CALL PR INTCHAR ( LF ) ; 

end crlf; 

PRINT: PROCEDURE (A)J 
DECLARE A ADDRESS; 

CALL MON1 (9, A)5 
END print; 

PRINT$ERROR : PROCEDURE (CODS); 

/* THIS PROCEDURE IS USED TO PRINT COMPILER ERRORS TO 
CONSOL */ 

DECLARE CODE ADDRESS, 

I BYTE, 
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C0DE1 (6) address; 

IF CODE = FALSE THEN 

do; 

DO I = 0 TO 55 

CODEl(I) = 0; 

end; 

1=0; 

end; 

ELSE 

IF CODE = TRUE THEN 

do; 

I = 0; 

DO WHI LE ( ( I <> 6) AND ( CODEl(I) <> 0)); 

call crlf; 

CALL PR I NTCHAR (HIGH( CODE1 ( I ) ) ) > 

CALL PR INTC HAR( LOW (CODEl(I))); 

CODEKI ) = 0; 

I = I + U 

end; 

I = 0; 

end; 

ELSE 

IF (CODE = 'N?') OR (CODE = 'SL') OR (CODS = 'NV') THEN 

do; 

CALL crlf; 

CALL PR I NTCHAR ( HIGH ( CODS )) J 
CALL PRI NTCHAR ( LOW ( CODE ) ) ; 

end; 

ELSE 

do; 

IF I <> 6 THEN 

do; 

CODEKI ) = code; 

1=1+1; 

end; 

end; 

end print$error; 

FAT ALiEREOR : PROCEDURE( REASON ) ; 

DECLARE REASON ADDRESS; 

call pr i nt Terror ( reason ) ; 

CALL PRINT^ERROR(TRUE) ; 

CALL TIME(10); 

CALL 300TJ 

end fatal$error; 

OPEN: procedure; 

IF M0N2 (15,IN$ADDR)=255 TEEN CALL FAT ALi ERROR ( 'OP ' ) ; 
END open; 

MORE$INPUT: PROCEDURE BYTE; 

/* READS THE INPUT FILE AND RETURNS TRUE I? A RECORD 
WAS READ. FALSE IMPLIES END OF FILE */ 

DECLARE DC NT BYTE; 
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IF (DCNT:=MON2(20,. INPUT$FCB ) )>1 
THEN CALL FATAL$ERROR( 'BR ' ) ; 

RETURN NOT(DCNT); 

END moreKnput; 

MAKE: PROCEDURE; 

/* DELETES ANT EXISTING COPT OF THE OUTPUT FILE 
AND CREATES A NEW COPT*/ 

CALL MON1 ( 19 , . OUTPUT* FCB ) » 

IF M0N2 ( 22 , . OUTPUT* FCB ) =255 THEN CALL FATAL* ERROR (' MA ' ) 
END make; 

WRITE$OUTPUT: PROCEDURE J 

/* WRITES OUT A BUFFER */ 

CALL MONK 26, . 0UTPUT*3UFF ) 5 /* SET DMA */ 

IF M0N2(21 , .OUTPUT* FCB)O0 THEN CALL FATAL*ERROR ( 'VR ' ) J 
CALL MON1(26,80H); /* RESET DMA */ 

END write*output; 

MOVE: PROCEDURE ( SOURCE , DESTINATION, COUNT); 

/* MOVES FOR THE NUMBER OF BTTES SPECIFIED BT COUNT */ 
DECLARE (SOURCE, DESTINATION) ADDRESS, 

( S *BYTE BASED SOURCE, D*BYTE BASED DESTINATION, COUNT) 
BYTE * 

DO WHILE ( COUNT : =COUNT - 1) <> 255; 

d*byte=s*byte; 

SOURC E=SOURCE +1 ; 

DESTINATION = DESTINATION + 1? 

end; 

END move; 

FILL: PR OCEDURS(ADDR, CHAR, COUNT ) ; 

/* MOVES CHAR INTO ADDR FOR COUNT BTTES */ 

DECLARE ADDR ADDRESS, 

(CHAR, COUNT, TEST BASED ADDR) BYTE; 

DO WHILE ( COUNT:=COUNT -1)0255; 

DEST=CHARJ 
ADDR=ADDR + 1J 

end; 
end fill; 



/* * * 
DECLARE 


* * * 


SCANNER LITS 


LITERAL 


LIT 


'15% 


I NPUTASTR 


LIT 


'32', 


PERIOD 


LIT 


'1', 


INVALID 


LIT 


'0' ; 


/# * * * 


* SCANNER 


TABLES * * * 



DECLARE TO KEN* TABLE (*) BYTE DATA 

/* CONTAINS THE TOKEN NUMBER ONE LESS THAN THE 
FIRST RESERVED WORD FOR EACH LENGTH OF WORD */ 
(0,0 ,1 ,4,5,15,22 ,32 ,39 , 44 , 4? ,49 ,51 ,55 , 56 , 57 ) , 
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TABLE (*) BYTE DAT A ( 'FD ' , 'OF ' , 'TO ' , 'PI C ' , 'COMP ' , ' DATA ' , ' FILS ' 
, 'LEFT' , 'MODE' , 'SAME', 'SIGN', ' SYN C ' , ' ZERO ' , 'BLOCK', 'LABEL' 

, 'QUOTE', 'FIGHT', 'SPACE', ' US AGE ',' VALUE ',' AC CESS ' , 'ASSIGN' 

, 'AUTHOR', 'FILLER', 'OCCURS', 'RANDOM', 'RECORD', 'SELECT' 

, 'DISPLAY' , 'LEADING' , 'L INKAGE ', 'OMITTED ' , 'RECORDS ' 

, 'SECTION', 'D I VISION ', 'RELATIVE' , 'SECURITY ', 'SEPARATE' 

, 'STANDARD', 'TRAILING', 'DEBUGGING', 'PROCEDURE', 'REDEFINES' 

, 'PROGRAM-ID' , 'SEQUENTIAL' , 'ENVIRONMENT ' , ' I-O-CONTROL ' 

, 'DATE-WRITTEN ' , 'FILE-CONTROL ' , 'INPUT-OUTPUT ' , 'ORGANIZATION ' 

, 'CONFIGURATION' , 'IDENTIFICATION ' , 'OBJECT-COMPUTER' 

, 'SOURCE-COMPUTER ', 'WORKING-STORAGE') , 



OFFSET (16) ADDRESS 



/* NUMBER OF 


BYTES TO INDEX INTO 


THE TABLE 


FOR EACH 


LENGTH */ 






INITIAL (0,0, 


0,6,9,45,80 


,128,170, 


218,245,265 


287,335, 


348,362) , 






WORDSCOUNT (*) BYTE DATA 






/* NUMBER OF 


WORDS OF EACH SIZE */ 


(0,0, 3, 1,9, 7, 


8, 6, 6, 3, 2, 2 


,4, 1,1, 3) 


♦ 


maxSlen 


LIT 


'16', 




ADDSEND ( * ) BYTE DATA 


('PROCEDURE '), 


LOOKED 


BYTE 


INITIAL 


(0) , 


HOLD 


BYTE, 






BUFFERS END 


ADDRESS 


INITIAL 


( 100H ) , 


NEXT 


BASED 


POINTER 


BYTE, 


INBUFF 


LIT 


'80H ' , 




CHAR 


BYTE, 






accumSleng 


LIT 


'50 ' , 




accumSlenSps>i 


LIT 


'51', 




/* = TO ACCUMSLENG PLUS 


l v 





ACCUM (ACCUMSLENS?Sl) BYTE, 

DI SPLAY ( 74 ) BYTE INITIAL (0), 

TOKEN BYTE, /^RETURNED FROM SCANNER */ 

EDITSFLAG BYTE I N IT IAL ( FALSE ) J 



/* * * * * PROCEDURES USED BY THE SCANNER * * * */ 

N EXT $ CHAR : PROCEDURE BYTE; 

IF LOOKED THEN 

do; 

looked=false; 

RETURN ( CHAR :=HOLD ) > 

end; 

IF ( ?OINTSR:=POINTER + 1 ) >= BUFFERSSND THEN 

do; 

IF NOT MORES INPUT THEN 

do; 

bufferSend=. memory; 

?ointer=. addsend; 

end; 



162 



ELSE ?ointer=inbuff; 

end; 

IF NEXT = EOFFILLER THEN 

do; 

BUFFER$END = .MEMORY ; 

POINTER = .ADD$END; 

end; 

RETURN (CHAF.:=NEXT) ; 

END NEXT $ CHAR; 

GET$C EAR : PROCEDURE; 

/* THIS PROCEDURE IS CALLED WHEN A NEW CHAR IS 
NEEDED WITHOUT THE DIRECT RETURN OF THE CHARACTER*/ 

char=next$char; 
end get^cear; 

DISPLAY$LINE : PROCEDURE; 

DECLARE I BYTE? 

IF NOT LISTt INPUT THEN RETURN; 

IF NOT EDIT$FLAG THEN 

do; 

DISPLAY ( DISPLAY( 0 ) + 1) = ' J 

CALL PR I NT ( .DISPLAY(l) ); 

end; 

ELSE DO I = 1 TO DISPLAYS); 

CALL PRINTCHAR (DISPLAY ( I ) ) ; 

end; 

DISPLAY ( 0 ) = 0J 
EDI T$FLAG = FALSE; 

end displaySline; 

LOAD$DIS PLAY : PROCEDURE; 

IF DISPLAY (0 ) < 72 THEN 

DISPLAY (DISPLAY(0 ) :=DISPLAY(0) + 1) = CHAR; 

IF CHAR = THEN EDIT$FLA.G = TRUE? 

CALL gst^char; 
end load$display; 

PUT: procedure; 

IF ACCUM ( 0 ) < AC CUM £L ENG THEN 
ACCUM(ACCUM(0) :=ACCUM ( 0 ) +1 ) =CHAR 5 

call load$display; 

END put; 

EAT^LINE: PROCEDURE; 

DO WHILE CHAROCR; 

call loadsdisplay; 

end; 

end eat$line; 

GET$NO$BLANK: PROCEDURE; 

declare (n ,i ) byte; 
do forever; 

IF CHAR = ' ' THEN CALL LOAD$DI SPLAY ; 
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ELSE 

IF CHAR=CR THEN 

do; 

CALL dis?lay$line; 

CALL PRI NT$ ERROR ( TRUE ) J 
IF SSQ$NUM THEN N=8; ELSE N=2; 

DO I = 1 TO n; 

CALL load$display; 

END; 

IF CHAR = THEN CALL EAT$ LI NE J 
ELSE 

IF CHAR = ': ' THEN 

do; 

IF NOT DEBUGGING THEN CALL EAT$LIN3; 
ELSE CALL LOAD^DI S PLAY ; 

end; 

end; 

ELSE 

return; 

end; /* END OF DO FOREVER */ 

END get$no$blank; 

SPACE: PROCEDURE BYTE; 

RETURN (CHAR-' ') OR ( CHAR-CR ) J 
END space; 

DELIMITER: PROCEDURE BYTE; 

/* CHECKS FOR A PERIOD FOLLOWED BY A SPACE OR CR*/ 

IF CHAR <> THEN RETURN FALSE; 

hold=next$cear; 

looksd=true; 

IF SPACE THEN 

do; 

CEAR = 

RETURN TRUE; 

end; 

CHAR-'. '? 

RETURN FALSE; 

end delimiter; 

END$OF$TOXEN : PROCEDURE BYTE? 

RETURN SPACE OR DELIMITER? 

END END$OF$TOKEN? 

GET$LITERAL: PROCEDURE BYTE? 

CALL LOADS DISPLAY; 

DO FOREVER? 

IF CHAR- QUOTE THEN 

do; 

CALL loadsdisplay; 

RETURN LITERAL? 

end; 

CALL put; 

end; 
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END get^literal; 



LOOK$UP: PROCEDURE BYTE; 

DECLARE POINT ADDRESS, 

HERE BASED POINT (1) BYTE, 

I byte; 

MATCH: PROCEDURE BYTE? 

DECLARE J BYTE; 

DO J=1 TO ACCUM(0)J 

I? HERE ( J -1)0 ACCUM(J) THEN RETURN FALSE; 

end; 

RETURN TRUE; 

END match; 

POINT=OFFSET( ACCUM( 0) )+ .TABLE; 

DO 1=1 TO WORDS COUN T( AC CUM ( 0 ) ) ; 

IF MATCH THEN RETURN IJ 
POINT = POINT + AC CUM ( 0 ) J 

end; 

RETURN FALSE? 

end looksup; 

RES ERVED$VORD : PROCEDURE BYTE; 

/* RETURNS THE TOKEN NUMBER OF A RESERVED WORD IF TH 
CONTENTS OF TEE ACCUMULATOR IS A RESERVED WORD, OTHE 
RETURNS ZERO */ 

DECLARE VALUE BYTE J 
DECLARE NUMB BYTE? 

IF AC CUM ( 0 ) > MAX$LEN THEN RETURN 0; 

IF (NUMB :=T0KEN$TA3LE( ACCUM( 0) ) )=0 THEN RETURN 05 
IF ( VALUE:=LOOKSUP)=0 THEN RETURN 0; 

RETURN (NUMB + VALUE); 

END RESSRVED$WCRP; 

GETSTOKEN : PROCEDURE BYTE; 

ACCUM(0)=0; 

CALL GETSNCS3LANK; 

IF CHAR=0U0TE THEN RETURN GETSLITERAL5 
IF DELIMITER THEN 

do; 

call put; 

RETURN PERIOD; 

end; 

do forever; 

CALL PUT # 

IF ENDSOFSTOKEN THEN RETURN INPUTSSTR; 

END; /* OF DO FOREVER */ 

END getstoken; 

SCANNER: PROCEDURE; 

DECLARE CHECK 3YTEJ 

DO forever; 

IF (TOKEN : =G ST $ TOKEN ) = INPUTSSTR TEEN 
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IF (CHECK :=RESERVEDiWORD) <> 0 THEN rOKSN=CHECK; 
IF TOKEN <> 0 THEN RETURN; 

CALL PRINT$SRROR ('SE')J 
DO WHILE NOT END$OF$TOKEN J 
CALL GET$CHAR» 

END; 

end; 

end scanner; 

PR I NT$AC CUM : PROCEDURE; 

ACCUM(ACCUM(0)+1 )='$'; 

CALL PR I NT ( . ACCUM ( 1 ) ) 5 

END print$accum; 

PRINT$NUMBER: PROCEDURE ( NUMB ) ; 

DECLARE(NUMB,I,CNT,K) BYTE, J(*) BYTE DATA( 100,10); 

DO 1=0 TO l; 

CNT=0; 

DO WHILE NUMB >= ( K : = J ( I ) ) ; 

NUMB* NUMB - K; 

CNT=CNT + i; 

end; 

CALL PRI NTCHAR ( '0 ' + CNT) ; 

end; 

CALL PR I NT CHAR ( '0 ' + NUMB); 

END PRINTS NUMBER; 

IN IT$SCANNER : PROCEDURE; 

/* INITIALIZE FOR INPUT - OUTPUT OPERATIONS */ 
DECLARE CONS CBL (*) BYTE DATA ( 'CBL ' ) , 

I BYTE, 

TESTFLAG BYTE? 

CALL MOVE ( FARMS , .P ARM LI ST ,S ) ; 

IF PARMLI ST( 0 ) = THEN 

do; 

i = 0 ; 

DO WHILE ( TESTFLAG :=PARMLI ST ( I :=I+1 ) ) <> ' '; 

IF TESTFLAG = 'L ' THEN LI ST$ IN ?UT=NOT LIST$INPUT; 

IF TESTFLAG = 'S' TEEN SEQ$NUM= NOT SEOSNUM; 

IF TESTFLAG = THEN ?RINT$PR0D = NOT PRINTSPRODJ 

IF TESTFLAG = '1 ' THEN PP.INTSTOKEM = NOT PPINTSTOKEN; 

end; 

end; 

CALL MOVE (.CONSCBL, IN SADDR + 9, 3)5 
CALL FILL( INSADDR + 12,0,5); 

CALL OPEN? 

CALL MOVE( INADDR,.0UTPUT$FCB,9); 

OUTPUT SFCB (32 ) = 0; 

OUTPUT SEND=( OUTPUTS PTR : = . CUTPUTSBUFF - 1) + 1285 
CALL make; 

CALL GETSCHAR; /* PRIME THE SCANNER */ 

IF SEQ$NUM THEN 
DO I = 1 TO 6; 

CALL LOADSDISPLAYJ 
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E ND » 



IF CHAR = '*' THEN CALL EAT$LINE*, 

CALL GETiNO^BLANKJ 

call pp. i nt Terror (false) ; /* initializes error 

MSG OUTPUT */ 

END IN ITiSCANNERj 



/* * * * END OF SCANNER PROCEDURES * * * */ 

/* * * * * SYMBOL TABLE DECLARATIONS * * * */ 



DECLARE 


CURSSYM 




ADDRESS, 


/^SYMBOL BEING ACC 


SYMBOL • 




BASED CUR$SYM 


(1) BYTE, 


SYMBOL$ADDR 




BASED CUR$S YM 


(1) ADDRESS, 


NEXT$ SYMiENTRY 




BASED NEXT$S YM 


ADDRESS , 


HASH$PTR 
SAVE$ ADDR 
DISPLACEMENT 




ADDRESS , 
ADDRESS , 
LIT 


'13', 


HASH$MASK 




LIT 


'3FH ' , 


S^TYPE 




LIT 


'2', 


OCCURS 




LIT 


'12% 


ADDR2 




LIT 


'4', 


P^LENGTE 




LIT 


'3', 


S^LENGTH 




LIT 


'3', 


LEVEL 




LIT 


'10', 


DECIMAL 




LIT 


'11', 


LOCATION 




LIT 


'2', 


REL$ ID 




LIT 


'5', 


START$NAME 




LIT 


'12', /*1 LESS*/ 


MAX$I D$LEN 




LIT 


'12'; 


/* * * 




TYPE LITERALS 




DECLARE 


SEQUENTIAL 


LIT 


'i;. 




S2Q$RELATIVE 


LIT 


'2', 




RANDOM 


LIT 


'3', 




VARI ABLE$LENG 


LIT 






GROUP 


LIT 


'6' , 




COMP 


LIT 


'2i'; 





/* * * * SYMBOL TABLE ROUTINES * * * */ 



IN IT$SYM30L : PROCEDURE; 

/* INITIALIZE HASH TABLE AND FIRST COLLISION FIELD */ 
FREE$STORAGE = .MEMORY,* 

CALL FILL (FREEi STORAGE ,0,130); 

NEXT $S YM=? REE $ STORAGE +128 J 
NEXT $SYM$ENTRY=0 ; 

END I NlTiSYMBOLJ 



GET$PiLENGTH: PROCEDURE BYTE; 
RETURN SYMBOL ( P$ LENGTH ) J 
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END get$p$length; 



SET$ADDRESS: PROCEDURE ( ADDR ) 5 
DECLARE ADDR ADDRESS » 

S IMBOL$ADDR( LOCATION )=ADDRJ 
END SET$ ADDRESS > 

GET$ ADDRESS : PROCEDURE ADDRESS* 

RETURN SYMBOL$ADDR ( LOCATION ) ; 

END GETiADDRESS; 

GET$TYPE : PROCEDURE BYTE*, 

RETURN SYMBOL(S$TYPE) J 

END get$type; 

SET^TYPE: PROC EDURE ( TYPE ) ; 

DECLARE TYPE BYTE; 

symbol(s$type)=type; 
end set$type; 

OR$TYPE: PROCEDURE (TYPE ) 5 
DECLARE TYPE BYTE* 
SYMBOL(S$TYPE)=TYPE OR GET^TYPE 5 

END or$type; 

GETiLEVEL: PROCEDURE BYTE*, 

RETURN SYMBOL ( LEVEL )5 
END get$level; 

SET$LEVEL : PROCEDURE (LVL)J 
DECLARE LVL BYTE; 

symbol(level)=lvl; 
end set^level; 

GET$DECI MAL : PROCEDURE BYTE? 

RETURN SYMBOL (DECIMAL ) ; 

end getsdecimal; 

SST$DECIMAL: PROCEDURE (DEC); 

DECLARE DEC BYTE; 

SYMBOL ( DEC IMAL )=DEC * 

END set$decimal; 

SET$S$LENGTH: PROCEDURE (EOW$LONG ) ; 
DECLARE HOW^LONG ADDRESS*, 

SYMBOL$ ADDR (S ^LENGTH) = HOW$LONG5 

END set$s$length; 

GET$S ^LENGTH : PROCEDURE ADDRESS; 

RETURN SYMBOL $ADDR ( S$LENGTH) J 
END GET$S$LENGTH5 

SET$ADDR2 : PROCEDURE (ADDR); 

DECLARE ADDR ADDRESS; 
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SYMB0L$ADDR(ADDR2)=ADDR? 

END SET$ ADDR2 ? 

GETSADDR2: PROCEDURE ADDRESS? 

RETURN SYMBOL^ ADDR( ADDR2 ) ? 

END GET$ ADDR2 ? 

SET^OCCURS: PRCCEDURE(OCCUR) ? 

DECLARE OCCUR BYTE? 

SYMBOL ( OCCURS )=OCCUR? 

END SET$OCCURS? 

GET^OCCURS : PROCEDURE BYTE? 

RETURN SYMBOL (OCCURS)? 

END GET$ OCCURS ? 

SET$IO$ADDRS : PROCEDURE? 

SYMBOL$ ADDR ( LOCATION ) = NEXT AS YM ? 
SAVESADDR = CUR$SYM? 

END SET$ 10$ ADDRS ? 



* 


PARSER 


DECLARATIONS * * * */ 


DECLARE 






INT 


LIT 


'63', /* CODE FOR INITIALIZE */ 


SCD 


LIT 


'66', /* CODE FOR SET CODE START 


PSTACKSIZE 


LIT 


'30', /* SIZE OF PARSE STACKS*/ 


STATESTACK 


(PSTACKSIZE) BYTE, /* SAVED STATES */ 


VALUE 


(PSTACKSIZE) ADDRESS, /* TEMP VALUES * 


V ARC 


(51) 


BYTE, /*TEMP CHAR STORE*/ 


ID$STACK 


(10) 


ADDRESS INITIAL (0), 


IDASTACK $PTR 


BYTE 


INITIALS) , 


HOLDALIT (ACCUMALEN$P$1 ) 


BYTE, 


EOLDASYM 


ADDRESS , 


PEN DING$ LITERAL 


BYTE 


I N ITI AL( FALSE ) , 


?ENDING$LIT$ID 


ADDRESS , 


REDEF 


BYTE 


INITIAL (FALSE), 


REDEF$ONE 


ADDRE 


SS, 


REDEFATWO 


ADDRESS , 


TEMPAHOLD 


ADDRESS , 


TEMP$TVO 


ADDRESS, 


COMPILING 


BYTE 


INITIAL(TRUE) , 


SP 


BYTE 


INITIAL (255), 


MP 


BYTE, 




MPP1 


BYTE , 




NOLOOK 


BYTE 


I N ITI AL ( TRUE ) , 


(I » J * K ) 


BYTE, 


/*I NDI Cl ES FOR THE PARSER* 


STATE 


BYTE 


INITIAL' STARTS ) , 


VALUEAFLAG 


BYTE 


INITIAL! FALS E ) , 


VALUE$LEVSL 


BYTE 


INITIALS), 


TRUNC$FLAG 


BYTE 


INITIAL (TRUE ) ? 


/* * * * 


PARSER 


ROUTINES *****/ 



BYTE$OUT : PR0CSDURE(0NE$3YTE) ? 

/* THIS PROCEDURE VRITES ONE BYTE OF OUTPUT ONTO THE DISK 
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IF REQUIRED THE OUTPUT BUFFER IS DUMPED TO THE DISK */ 
DECLARE ONESBYTE BYTE; 

IF ( OUTPUT $PTR:=OUTPUT$PTR + 1)> OUTPUTSEND THEN 

do; 

CALL WRITES OUT PUT; 

OUTPUT$PTR=. OUTPUT $BUFF; 

end; 

output$chak=one$byte; 
end eyteSout; 

STRlNGiOUT: PROCEDURE ( ADDR t COUNT ) ; 

DECLARE (ADDR , I , COUNT ) ADDRESS, (CHAR BASED ADDR) BYTE 
DO 1=1 TO count; 

CALL BYTESOUT(CHAR); 

ADDR= ADDR+1 J 

END; 

END STRINGSOUT; 

ADDRSOUT: PROCEDURE(ADDR) ; 

DECLARE ADDR ADDRESS; 

CALL BYTESOUT(LOW(ADDR) ); 

CALL BYTE S OUT (HIGH ( ADDR )) ; 

END addr$out; 

FI LL$ STR ING : PROCEDURE( COUNT, CHAR) ; 

DECLARE (I, COUNT) ADDRESS, CHAR 3YTE5 
DO 1=1 TO count; 

CALL BYTESOUT ( CHAR ) ; 

end; 

end fillsstring; 

STARTS INITIALIZE : PROCEDURE (ADDR , CNT ) ; 

DECLARE (ADDR, CNT) ADDRESS; 

CALL BYTEOUT ( I NT ) ; 

CALL ADDRSOUT (ADDR) J 
CALL ADD D SOUT( CNT) ; 

END startSinitialize; 

3UILDSSYMB0L: PROCEDURE (LEN ) ; 

DECLARE LEN BYTE, TEMP ADDRESS; 

temp=next$sym; 

IF ( NEXTSSYM:=. SYMBOL ( LEN : =LEN+DI SPLACEMENT ) ) 

> MAXSMEMORY THEN CALL F A T A L S ERRO R ( ' S T ' ) J 
CALL FILL (TEMP, 0, LEN ) J 

END buildssymbcl; 

DUPSIDENSTEST: PROCEDURE; 

DECLARE I BYTE,* 

IF REDEFSFLAG THEN 

do; 

RED EFSFLAG = false; 
return; 

end; 
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ELSE 

IF FI LE$DESC$FLAG THEN 

do; 

FILEiDESC$FLAG = FALSE,* 

I = 0 ; 

DO WHILE DUPi IDENi ARRAY ( I ) <> 0? 

IF DU Pi I DEN £ ARRAY ( I ) = CURiSYM THEN 

do; 

CALL PRINT$ERR0R( 'DI ' ) J 

return; 

end; 

i = i + i; 

IF I > 23 THEN 

do; 

CALL PR I NTiERROR ( 'EF') J 

return; 

end; 

end; 

DUPilDENi ARRAY ( I ) = CURSYM; 

return; 

end; 

ELSE 

CALL print$error( 'di ' ) ; 

END DUPi IDENiTEST ; 

MATCH: PROCEDURE ADDRESS ; 

/* CHECKS AN IDENTIFIER TO SEE IF IT IS IN THE SYMBOL 
TABLE. IF IT IS PRESENT, CURiSYM IS SET FOR ACCESS. 
OTHERWISE A NEW ENTRY IS MADE AND THE PRINT NAME 
IS ENTERED. ALL NAMES ARE TRUNCATED TO MAX SI DiLEN*/ 
DECLARE POINT ADDRESS, 

COLLISION BASED POINT ADDRESS, 

(HOLD, I) byte; 

IF VARC ( 0 ) >MAXi IDiLEN 

THEN V A R C ( 0 ) = M AX$ IDiLEN ; 

/* TRUNCATE IF REQUIRED */ 

HOLD = 0 ; 

DO 1=1 TO VAF.C(0); /* CALCULATE HASH CODE */ 

EOLD=HOLD + VARC (I ); 

end; 

POI NT=FREE$ STORAGE + SHL( (HOLD AND HAS H$MASK ) , 1 ) J 
DO forever; 

IF COLLI S I ON=0 TEEN 

do; 

IF FILEiDESCSFLAG THEN 

do; 

FILEiDESCiFLAG = FALSE; 

CALL PR I NT$ ERROR ( 'UI ' ) J 

end; 

ELSE 

IF REDEF$ FLAG THEN 

do; 

REDEFiFLAG = FALSE; 

CALL PRI NT$ ERROR ( 'UI ') ; 



171 



end; 

cur£sym,collision=next$sym; 

CALL BUILD$SYMBOL(VARC(0) ); 

/* LOAD PRINT NAME */ 

SYMBOL ( P$ LENGTH )=VARC ( 0 ) J 
DO I = 1 TO VARC(0); 

S YMBOL ( S TARTi NAME + I ) = VARC ( I ) ? 

end; 

RETURN CUR$SYMJ 

end; 

ELSE 

do; 

cur$sym=collision; 

IE (HOLD:=GET£P$LENGTH)=VARC (0) TEEN 

do; 

1=1 ; 

DO WHILE SYMBOL ( STARTS NAME + I)= VARC( I ) 
IF (I :=I +1 ) >HOLD TEEN 

do; 

CALL DUP$IDEN$TEST ; 

RETURN (CUR$SYM:=COLLISION) ; 

end; 

end; 

end; 

end; 

point=collision; 

end; 

end match; 

ALLOCATE : PROCEDURE(BYTES$REQ) address; 

/* THIS ROUTINE CONTROLS THE ALLOCATION OF SPACE 
IN THE MEMORY OF THE INTERPRETER. */ 

DECLARE (HOLD ,BYTES$REQ ) ADDRESS; 

hold=nex?$available; 

IF ( NEXT $A VA I LABLE :=NEXT$ AVAILABLE + 3YTES$REQ) 
>MAX$INT$MEM 

THEN CALL FATAL$ERROR ( 'MO ' ) J 
RETURN HOLD; 

end allocate; 

DIGIT: PROCEDURE (CHAR) BYTE; 

DECLARE CEAR 3YTEJ 

RETURN (CEAR <= '9') AND (CHAR >= '0')? 

END digit; 

SET$REDEF: PROCEDURE ( OLD, NEW ) ; 

DECLARE (OLD, NEW) ADDRESS; 

redef$one=old; 

RSDEF$TWO=NEW; 

redef=true; 
end set^redsf; 

SET^CURSSYM: PROCEDURE; 
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CUR$SYM=IDiSTACK( IDiSTACK^PTR ) ? 

END set$cur$sym? 

STACK$LEVEL : PROCEDURE BYTE? 

CALL set$cup$sym; 

RETURN GET$LEVEL? 

END STACK$LEVEL? 

LOAD$LEVEL : PROCEDURE? 

DECLARE HOLD ADDRESS? 

LOAD$REDEF$ADDR : PROCEDURE? 

CUR$SYM=REDEF*ONE? 

HOLD=GET$ ADDRESS ? 

END LOAD^REDSFiADDR? 

IF I D^STACK ( 0 ) <> 0 THEN 
DO? 

IF VALUE (SP— 2) =0 THEN 
DO? 

CALL SET$CUR*SYM? 

HOLD=GET$ S$ LENGTH + GET$ ADDRESS ? 

END? 

ELSE DO? 

IF FILE$SEC$SND THEN 
DO? 

IF IDiSTACK( ID^STACK$PTR) <> REDEF$ONE 
THEN 
DO? 

CALL PFINT$ERROR( 'Rl' ) ? 
REDEF$ONE=ID$STACK(IDiSTACK$?TR) ? 
END? 

END? 

CALL LOAD$REDEF$ADDR ? 

END? 

IF ( ID$STACK$PTR:=ID$STACK$PTR+1 ) >9 THEN 
DO? 

CALL PRINT$ERR03( 'EL')? 

IDiSTACK$PTR=9? 

END? 

END? 

ELSE H0LD=NEXT$AV'AILA3LS; 

ID$STACK( ID$STACK$PTR ) =VALUE(MPP1 ) ? 

CALL SET$CUR$SYM? 

IF ( GET^LE VEL = 1) AND (NOT FILE£SEC$END ) THEN 
CALL SET$ADDR2( SAVS^ADDR ) ? 

CALL SET$ ADDRESS ( HOLD ) ? 

END LOADiLEVEL? 

REDEF$OR £V ALUE : PROCEDURE? 

DECLARE HOLD ADDRESS, 

(DEC, K,J, SIGN, CHAR ) BYTE? 

IF REDEF THEN 
DO? 
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a 






IF REDEF$TVO=CUR$SYM THEN 

do; 

hold=get$s$lengte; 

cur$sym=redef$one; 

IF EOLD>GET$S$ LENGTH THEN 

do; 

CALL PRINT$ERROR( 'R2' ) ; 

hold=get$s$length; 

CUR$SYM=REDEF$TWO; 

CALL SET$S$LENGTH(HOLD) J 

end; 

end; 

end; 

ELSE IF PENDI NG$LITERAL=0 THEN RETURN; 

IF ( PENDI NG$LIT$ IDOI D$ STACK $PTR) OR VALUE$FLAG 
THEN RETURN; 

IF PENDING$LITERAL <> 0 THEN 
CALL START$ I NIT I AL IZE( GET $ ADDRESS .HOLD: =GETi Si LENGTH ) ; 
I? PENDING$LITERAL>2 THEN 

do; 

IF PENDI NGiLI TERAL=3 TEEN CEAR='0'j 
ELSE IF PENDINGiLITERAL=4 THEN CHAR=' '; 

ELSE IF PENDING$LITERAL = 5 THEN CHAR = QUOTE', 

CALL FILL$STRlNG(HOLD, CHAR ) J 

end; 

ELSE IF PENDING$LITERAL = 2 TEEN 

do; 

IF HOLD <= HOLD$LIT ( 0 ) THEN 

CALL STRI NG$OUT ( .HOLDiLIT(l) .HOLD); 

ELSE DO* 

CALL STRI NGiOUT ( . EOLDiLIT ( 1 ) ,HOLD$LI T ( 0 ) ) J 
CALL FILLS STRING (HOLD - EOLD$LIT ( 0 ) , ' '); 
END,' 

end; 

ELSE IF PENDING$LITERAL=1 THEN 

do; 

/* THE NUMBER EANDELER */ 

DFCL ARE (DEC,MINUS$SIGN ,1 , J ,LIT$DSC , N$LENGTH , 
NUMiBEFORE, NUM$ AFTER , TYPE) BYTE, 

ZONE LIT '10H'; 

IF( (TYPE :=GETiTYPE )<16) OR (TYPE>21) THEN 
CALL PRINT$ERR0R ( 'NV')J 
NiLENGTH=GET$S$ LENGTH J 

dec=get$decimal; 

minus$sign=false; 

IF H0LD$LIT(1) = THEN 

do; 

minus$sign=true; 

j=i; 

end; 

ELSE IF HOLD$L IT ( 1 ) = '+' THEN J=i; 

ELSE J=0J 
LIT$DEC=0 ; 
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DO 1 = 1 TO HOLD $L I T ( 0 ) J 

IT HOLD$LIT (I THIN LIT$DEC=i; 

end; 

IF EOLDiLIT ( 0) <> 0 TEEN 
DO,* 

IF LIT$DSC=0 TEEN 

do; 

NUM$BEFORE=HOLD$LIT (0 )-J ; 

NUM$ AFTER =0; 

end; 
else do; 

NUM$BEFORE=LIT$DEC -J-l? 
NUM$AFTER=HOLDiLIT(0) - LITiDECJ 

end; 

end; 

ELSE IF HOLD$LIT(0) = 0 THEN 

do; 

NUM$BEFORE = 0J 
NUM$ AFTER = 0? 

LIT$DEC = 0; 

end; 

IF (I:=N$LENGTH - DEC )<NUM$ BEFORE THEN 
CALL PRINT$ERR0R( 'SL')J 
IF I >NUM$BEFORE THEN 
do; 

i=i-num$be?ore; 

IF MINUS$SIGN THEN 

do; 

1 = 1 - 1 ; 

CALL BYTE$OU?('0' + ZONE); 

end; 

CALL FILL$STRING(I , ' 0 '); 

end; 

ELSE IF MINUS^SIGN THEN HOLD $LIT ( J+l ) 
=HOLD$LIT(J+l)+ZONS; 

CALL STRING$0UT( . HOLDiLIT( 1 )+J ,NUM$3SF0RE ) J 
IF NUM^ AFTER > DEC THEN NUM$ AFTER = DEC? 

CALL STRlNG$OUT( .HOLD$LIT(l) + LITSDEC, NUMiAFTSR ) ; 
IF ( I :=DEC - NUM$ AFTER ) <>0 THEN 
CALL FILLiSTRlNG(I , ' 0 ' ) J 

END; 

IF NOT VALUEiFLAG THEN PENDI NG$LI TERAL=0 ; 

END REDEF$OR$VALOS; 

REDUCE$STACK : PROCEDURE; 

DECLARE HOLD$LENGTH ADDRESS; 

CALL SETiCUR$SYM; 

CALL REDEF$ORiVALUEJ 

hold$length=get$s$length; 

IF GET$TY?E > 128 THEN 

do; 

HOLD$LENGTH=HOLD$LENGTE * GET^OCCURS? 

end; 

I D$S TACK$PTR=ID$STACK$PTR - i; 
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CALL SET$CUR$SYM? 

CALL SET£S$LENGTH(GET$S£LSNGTH + EOLDi LENGTH ) ? 

CALL SET$TYPE (GROUP ) ? 

END rsduce$stack; 

END$OF$RECORD: PROCEDURE? 

DO WHILE IDiSTACE^PTR O 0; 

CALL set$cur$sym; 

CALL redef$or$7alue; 

ID$STACK( ID$STACK$PTR)=0? 

ID$STACK$PTR=ID$STAC5$PTR - 1 ; 

end; 

call set$cup.$sym; 
call redef$or^value; 

ID$STACK(0 )=0? 

TEMPiHOLD= ALLOCATE! TEM P$ TWO : =G ET$ S $ LENGTH ) ; 

END end$of$record; 

CO N7ERT$ INTEGER : PROCEDURE; 

DECLARE INTEGER ADDRESS; 

I NTEGER=0 ; 

DO I = 1 TO 7ARC (0 ) J 

IE NOT D IGI T ( 7 ARC ( I ) ) THEN CALL PRINT$ERROR( 'NN ' ) ; 

/* ERROR REC07ERY FOR AN '0 ' WHICH SHOULD 
HA7E BEEN A ZERO — '0 ' */ 

IF ( 7ARC ( I ) = 'O') THEN VARC(I) = '0'? 

INTSGER=SHL( INTEGER, 3 )+SHL (INTEGER , 1 )+(VARC( I )-'3 ' ) J 

end; 

7ALUE(SP)=INTEGER; 

END CONYERT$INTEGER? 

0Ri7ALUE: PROCEDURE ( PTR , ATTRIB ) ? 

DECLARE PTH BYTE, ATTRIB ADDRESS; 

7ALUS(PTR)=7ALUE(PTR) OR ATTRIB? 

END 0R$7ALUE; 

BUILD$FCB : PROCEDURE? 

DECLARE TEMP ADDRESS? 

DECLARE BUFFER (11 ) BYTE, (CHAR, I, J) BYTF? 

CALL FILL! -BUFFER, ' ',11)? 

J,I=0? 

DO WHILE (J < 11) AND (I< 7ARC(0))? 

IF ( CHAR : =7 ARC (I:=I + 1))='. ' THEN J=9? 

ELSE DO? 

BUFFER ( J ) =C HAR ? 

J=J+1? 

END? 

end; 

CALL SET$ ADDR2 ( TEMP : = ALLOC ATE ( 165 )) ? 

CALL START $INITIALI ZE(TEMP,37) ? 

CALL BYTE$CUT(0)? 

CALL STRING$OUT( .BUFFER, 11)? 

CALL FI LL$STRING ( 25 ,0 ) ? 

CALL 0R$VALDE(SP-1,1) ? 
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END buildSfcb; 

SETSS IGN : PROCEDURE ( NUMB) > 

DECLARE NUMB BYTE? 

IF GETSTY?E=17 THEN CALL S ETSTYPE ( VALUE (S P ) + NUMB)? 

ELSE CALL PRINT$ERROR( 'SG ' ) ? 

IF VALUE ( SP ) <>0 THEN CALL S ET SS SLENGTH( GETS S$ LENGTH + 1); 
END SETSSIGN? 

NUM$TRUNC : PROCEDURE ; 

DECLARE I 
J 

TRUNCSTYPE 
TRUNCSZERO 
SIGN$FLAG 
DECSFLAG 

TRUNC$ ZERO = TRUE? 

SIGN SFLAG = FALSE? 

DEC$FLAG = FALSE? 

HOLDSLIT ( 0 ) = 0J 

j = i; 
i = 0; 

IF ( ( TRUNCSTYPE: =GETSTYPE ) =16 ) OR (TRUNCS TYPE=17 ) OR 
( TRUNCSTYPE = 21) THEN 
DO WHILE J <= VARC(0); 

IF (VARC(J) <> '+') AND (VARC(J) <> THEN 

do; 

IF (VARC( J)='0') AND TRUNCSZERO THEN J=JJ 
ELSE IF {(VARC(J) >= '0') AND (VAPC(J) 

<=' 9 ') ) OR 

( VARC ( J ) = ' THEN 

do; 

IF DECSFLAG AND (VARC(J) = THEN 

CALL PRINTS ERROR ( 'MD ' ) ; 

ELSE do; 

HO LDSL IT( HOLDSLIT (0) :=H0LDSLIT (0 ) +1 ) 

=VAR C ( J ) ; 

IF VARC(J) <> '0' THEN TRUNCSZERO = FALSE; 
IF VARC(J) = THEN DECSFLAG = TRUE; 
i = i + i; 

end; 

end; 

ELSE IF ((VARC(J) < '0') OR (VARC(J) > '9')) AND 
(VARC(J) <> '.') THEN CALL PR I NT A ERROR ( ' NN ' ) ; 

end; 

ELSE IF SIGN$FLAG THEN CALL PR I NT TERROR ( 'MS ' ) 

ELSE IF (VAF.C(J) = '+') OR (VARC(J) = THEN 

do; 

IF TRUNCSTYPE = 16 THEN CALL PR I NTS ERROR ( 'SG ' ) ; 

ELSE do; 

HOLDS LIT (HOLDS LI T(0) :=B0LDSLI T ( 0 ) +1 ) =VARC ( J ) ; 
SIGNSFLAG = TRUE? 

i » i + i; 



BYTE, 

BYTE, 

BYTE, 

BYTE, 

BYTE, 

byte; 



177 



end; 

end; 

j = J + 1 ; 

end;/* do while loop */ 

HOLD$LIT (0 ) = I; 

IP ( ( HOLD$L IT ( 0 ) = 1) AND ( (HOLD$LIT( 1 ) = '+') OR 
(HOLD$LIT( 1 ) = '-'))) OR (HOLD$LIT(0) = '0') THEN 

do; 

hold$lit( 0 ) = 0 ; 

HOLD$LIT( 1) = 0J 
END; 

END NUM^TRUNC; 

PIC^ANALIZER: PROCEDURE; 



DECLARE /* 


WORK AREAS 


AND VARIABLES 


FLAG 


BYTE, 




FIRST 


BYTE, 




COUNT 


ADDRESS , 




BUFFER (31 ) 


BYTE, 




SAVE 


BYTE, 




REPITITIONS 


ADDRESS, 




J 


ADDRESS , 




DEC^COUNT 


BYTE, 




CHAR 


BYTE, 




I 


BYTE, 




TEMP 


ADDRESS , 




TYPE 


BYTE, 




DEC$FLAG 


BYTE , 




K 


BYTE, 




/* * * MASKS 


* * */ 




ALPHA LIT 


' V, 




A $ ED IT LIT 


'2', 




AiN LIT 


'4', 




EDIT LIT 


'8', 




NUM LIT 


'16', 




NUM$ EDIT LIT 


'32', 




DEC LIT 


'64', 




SIGN LIT 


'128', 




NUMiMASK 


LIT 


'1010111 IB', 


NUMiED$MASK 


LIT 


'100001013' , 


S$NUM$MASK 


LIT 


'00101111B ' , 


ALPHA$MASK 


LIT 


'111111103', 


A$E$MASK 


LIT 


'11111100B' , 


A$N*MASK 


LIT 


'111010103', 


A$N$ E^MASK 


LIT 


'11100000B ' , 



/* TYPES */ 
NETIPE LIT '80' f 
NTYPE LIT '16', 
SNTIPE LIT '17', 
ATYPE LIT '8', 
AETYPE LIT '72', 



17 



ANTYPE LIT '9', 

ANETYPE LIT '73 ' J 

INC^COUNT : PF.OCEDURE( SWITCH) J 
DECLARE SWITCH EYTS; 

FLAG=FLAG CR SWITCEJ 

IF ( COUNT : = COUNT + 1) < 31 THEN BUFFER ( COUNT ) 

= char; 

end incAccunt; 

CHECK: PROCEDURE (MASK) BYTE J 

/* THIS ROUTINE CHECKS A MASK AGINST THE 
FLAG BYTE AND RETURNS TRUE ID THE FLAG 
HAD NO BITS IN COMMON WITH THE MASK */ 

DECLARE MASK BYTE; 

RETURN NOT ( (FLAG AND MASK) <> 0 )? 

END check; 

PI CA ALLOCATE : ?ROCEDURE( AMT) ADDRESS; 

DECLARE AMT ADDRESS; 

IF (MAX$INTAMEM:-MAX$INT$MEM - AMT) 

< NEXT$AVAI LABLE 

THEN CALL FATAL TERROR ('MO'); 

RETURN MAXAINTAMEM? 

END picAallocate; 

/* PROCEDURE EXECUTION STARTS HERE */ 

CURASYM = holdAsym; 

IF ( GETA LEVEL = VALUEALEVEL) THEN 7AL T JE$FLAG = FALSE? 
DSC AFLAG = FALSE? 

COUNT, FLAG ,DEC$COUN T=0? 

/* CHECK FOR EXCESSIVE LENGTH */ 

IF V ARC ( 0 ) > 30 THEN 
DO? 

call pr i nt Terror ('pc'); 
return; 

end; 

/* SET FLAG BITS AND COUNT LENGTH */ 
i =i; 

DO WHILE I <= VARC ( 0 ) ; 

IF (CHAR: =V ARC (I ) ) = 'A ' THEN CALL INC$COUNT(ALPHA) ; 
ELSE IF CHAR = 'B ' THEN CALL I N C $ C CU NT ( A $ ED I T ) J 

ELSE IF CHAR ='3' THEN CALL INCACCUNT ( NUM ) ; 

ELSE IF CHAR = 'X ' TEEN CALL INC ACOUNT (AAn ) J 

ELSE IF (CHART'S') AND (COUNT=0) THEN 

FLAG = FL AG OR SIGN? 

ELSE IF (CHAR = 'V') AND ( DSCA COUNT=0 ) THEN 

do; 

DECACOUNT = COUNT; 

decAflag = true; 
end; 

ELSE IF ( CHAR= ' /' ) OR (CHAP='0') THEN 
CALL INCACOUNTA(EDIT) ; 
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ELSE IF 

(CHAR-'Z') OR ( CHAR= ' , ' ) OR ( CHAR= '* ' ) OR 
(CHAR='+') OR (CHAR*'-') OR (CHAR*'*') THEN 
CALL INC$COUNT( NUM$EDIT) ; 

ELSE IF (CHAR*'.') AND ( DEC$COUNT=0 ) THEN 
EO * 

CALL INC*COUNT(NUM*EDIT) ; 

dec$c.ount=count; 

DEC$FLAG = TRUE; 

end; 

ELSE IF ( ( CHAR = 'C ' ) AND ( V ARC ( I +1 )= 'R ' ) ) OR 
( (CHAR* 'D ' ) AND ( V ARC ( I +1 ) = ' 3 ' ) ) THEN 

do; 

CALL I NC$COUNT ( N UM$ EDI T ) J 
CHAR=VARC( I :=I+1 ) 5 
CALL IN C* COUNT ( NUMiED IT ) J 

end; 

ELSE IF ( CEAR= '( ' ) AND (COUMTO0) THEN 

do; 

S AVE=V ARC ( I — 1 ) J 
REPITIT IONS = 0 J 

DO WHILE( CHAR : =v ARC ( I : = I +1 ))<>')' ; 

REPI TITIONS=SHL(REPITITIONS,3) + 

SHL( REPITIT IONS ,1) +(CHAR -' 0 '); 

end; 

char=save; 

DO J=1 TO REPITITIONS-1 ; 

CALL INC$COUNT(0) J 

end; 

end; 

else do; 

CALL PRINT* ERROR ('PC'); 

return; 
end; 
i=i+i ; 

END; /* END OF DO WHILE I<= VARC */ 

/* AT THIS POINT TEE TYPE CAN BE DETERMINED */ 

IF NOT CHECK ( NUM* EDI T ) THEN 

do; 

IF CHECK ( NUM*ED$MAS 5 ) THEN TYPE=N ETYPE ; 

end; 

ELSE IF CHECK(NUM$MASK ) THEN TYPE=NTYPE; 

ELSE IF CHECK ( SNUM$MASK ) THEN TYPE=S NTYPE; 

ELSE IF CHECK ( ALPHA $M ASK ) THEN TYPE = ATYPE; 

ELSE IF CHECK ( A$E*M ASK ) THEN TYPE = AETYPE? 

ELSE IF CHECK ( A$ N*MASK ) THEN TYPE=ANTY?EJ 
ELSE IF CHECK (A$N*E$M ASK) T W SN T Y PE=AN ETYPE ; 

IF T Y?E=0 THEN CALL PR I NT $ERROR ( 'PC ' ) 5 
ELSE do; 

IF ( GET*TYPE=1 28 ) THEN CALL S ET$TYPE( 12S+TYPE) ; 

ELSE CALL SETiTYPE ( TYPE ) J 

CALL S ET*S LENGTH ( COUNT + GET $S ^LENGTH ) J 

IF (TYPE AND 64) <> 0 THEN 

do; 
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CALL SET$ ADD R2 ( TEMP :=PI C ^ALLOCATE (COUNT ) ) ? 

CALL STAF.T$ INITIALIZE (TEMP .COUNT) ? 

CALL STRlNG$OUT( .BUFFER + 1, COUNT); 

end; 

IF ( DEC $COUNT <> 0) OR DSC$FLAG THEN 

do; 

IF (COUNT - DEC$ COUNT ) > 18 TEEN 
CALL PR I NT$ERROR ( 'DC ' ) ; 

CALL SET$ DEC IMAL ( C OUNT - DECiCOUNT ) ? 

end; 

end; 

IF (NOT TRUNC$FLAG) AND ((TYPE = 16) OR (TYPE = 17)) THEN 

do; 

DO K = 0 TO HOLD$LIT(0); 

V ARC ( K ) = HOLD$LITU); 

end; 

CALL NUM$ TRUNC J 
TRUNC$FLAG = TRUE; 

end; 

end pic$analizer; 

SET$FILE$ATTRI3: PROCEDURE? 

DECLARE TEMP ADDRESS. TYPE BYTE? 

IF CUR$SYMO VALUE (MPP1 ) THEN 

do; 

TEMP=CURiSYM; 

CUR$SYM=VALUE(MPP1) ? 

SYMBOLS A DDR ( REL$ IB )=TFMP > 

end; 

IF NOT ( TEMP : = VALUE (S P-1 ) ) THEN CALL P?lNT$ERROR ( ' N F ' ) > 

else do; 

IF TEMP=1 THEN TYPE=S EQUENT I AL ? 

ELSE IF TEMP=15 THEN TY?S=RANDOM? 

ELSE IF (TEMP=5) OR (IEM?=13) TEEN 
TYPE = SEQ$RELATIVEJ 
ELSE do; 

CALL PRINT$ERR0R( 'IA' )? 

TYPE=1? 

end; 

end; 

CALL SET$TY?E ( TYPE) J 

END set$file$attrib; 

LOADSLITERAL : PROCEDURE (LITSONE) ? 

DECLARE I BYTE, 

LI T$ONE BYTE, 

LIT$TYPE BYTE? 

litStype = getStype; 

IF LITSTYPE <> 0 THEN V ALUS$FLAG = FALSE? 

ELSE do; 

VALUE$FLAG = TRUE? 

VALUE$LEVEL = GET $ LEV EL ; 

END? 
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IF PENDING$LITERAL <> 0 THEN CALL PR INTSERRCR ('LE')J 
ELSE IF ( L IT$ONE = 0) CP. (LIT^TYPE = 0) THEN 

do; 

DO I = 0 TO VARC(0)J 
HOLD$L IT ( I ) = VARC( I) J 

end; 

IF (LIT$ONE = 1) AND (LITSTYPE = 0) THEN 
TRUNC$FLAG = FALSE; 

end; 

ELSE IF ( LI T$ONE = 1) AND ( ( LITiTYPE = 16) OR 

( LIT$TYPE = 1?) OF (LIT$TYPE = 21)) THEN 
CALL NUM$TRUNC; 

ELSE IF (LIT$ONE = 1) AND ((LIT^TYPS <> 16) OR 

( LIT$TYPE <> 17) OR ( LIT$TYPF <> 21)) AND 
( LI T$TYPE <> 0) THEN 

do; 

CALL PRINT$ERROR( 'LV' )J 
DO I = 0 TO VARC (0 ) ; 

HOLD$ LI T ( I ) = VARC (1)5 
end; 

PENDING $LI TERAL = 2; 

end; 

end load$literal; 

REDEF$TEST : PROCEDURE; 

DECLARE SAVE^REDEF BYTE, 

SAVS$REDEF$ONE ADDRESS, 

SAVE$REDEF$TWO ADDRESS; 

SAVS$REDEF$ONE = REDSF5CNE; 

SAVE$REDEF$TVO = REDETiTWOI 
REDEF$CNE = CUR$SYM; 

CALL SET$CUR^SY^» 

P.EDEF$TVO = CUR^SYMJ 
SAVE$REDE7 = RSDEF ; 

REDSF = TRUE; 

CALL REDE?$ OR t VALUE; 

I D^STACK ( ID$STACK$ PTR ) = 0J 
I D$ STACKS PTR = ID^STACK^PTR - i; 

REDEFINE = S AVS$REDEF$ONE; 

REDEF$TWO = SAVE$R EDEF$TVO J 
REDEF = SAVE$REDEF; 

end redef$test; 

CHECK$LVL$FILES: PROCEDURE; 

DECLARE NEW £ LEV EL BYTE J 
HOLD^S YM, CUR * S YM= V AL UF ( MP-1 ) ; 

CALL SET$ LEVEL ( NEW $L EVEL : =V ALUE( NP-2 ) ); 

IF NSW$LEVEL = 1 THEN 

do; 

IF ID$STACK ( 0 ) <> 0 THEN 

do; 

DO WHILE STACK $LEVEL > U 
CALL REDUCE$STACKJ 

end; 
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DO WHILE I D$ STACKiPTR <> 0J 

CALL set$cur$sym; 

CALL REDEF$OR$ VALUE ,* 

ID$STACK(ID$STACK$PTR) = 0; 

I D$STACK$PTR = ID$STACK$PTR - 1J 

end; 

cur$s ym = hold$sym; 

CALL SET$REDEF( IDiSTACK( 0) , V ALUE( MP-1 ) ) ; 
VALUE ( MP ) = i;/* SET REDEFINE FLAG */ 

end; 

end; 

ELSE DO WHILE STACK^LEVEL >= NEW$LEVEL; 

CALL reduce$stack; 
end; 

END CHECK^LVL^FILES; 

CHECK$LVL$WORK: PROCEDURE; 

DECLARE NEW$LEVEL BYTE, 

S AVEiSYM$L VL BYTE, 

STACK$REDUCED BYTE, 

SAVE^REDEF BYTE, 

SAVS$SYM ADDRESS,* 

S ST £ V ALU E$ CLAUSE : PROCEDURE; 

SAVEiREDEF = REDEF5 
REDSF = FALSE; 

call set$cur$sym; 
call redef$or$value; 
rsdef = save$redef; 

CURiSYM = hold^sym; 

END SET$VALUE$ CLAUSE? 

TRUNC$FLAG = TRUE; 

stack$reduced = false; 

HOLD$SYM,CUR$SYM=VALUE(MP-l ) ; 

CALL SET$LEVEL( NEW $ LEVEL : =V ALU E( MP-2) ) ; 

IF NEWSLEVEL = 1 THEN 

do; 

DO WHILE STACKiLEVEL > 1 AND ID$STACK( IDSST»CK$PTF.) <>0 
SAVE^SYM ,CUR$SYM=ID$STACK(ID$STACK$?TR - 1)5 
SAVE$SYK$LVL = GET$LEVEL; 

IF SAVE$ SYM^LVL = STACK^LEVEL THEN 

do; 

cur$s ym = save$sym; 
call redef$test; 
end; 

ELSE IF STACS$LEVEL > 1 THEN 

do; 

call reduce$stack; 

IF VALUE$FL AG AND ( VALUE5LEVEL = STACK^LEVEL) THEN 

do; 

VALUE$FLAG = FALSE 5 
CALL S ET $VALUE ^CLAUSE? 

end; 
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end; 

end;/* do while loop */ 

IE STACKSLEVEL = 1 AND IDSSTACK$PTR <> 0 THEN 

do; 

CURSS YM = IDSSTACK(ID$STACK$PTR - 1); 

CALL redef$test; 
end; 

IF VALUE ( MP ) = 0 AND ID$STACK ( I D$ ST ACK SPTR ) <> 0 THEN 

do; 

call endSofSrecord; 

REDEF = FALSE; 

end; 

IF (VALUE(MP) = 1) AND ( I D$ST ACK ( ID$STACK$ PTR ) = REDEFSONE) 
THEN CALL SETSVALUESCLAUSE ; 

CUR$SYM = HOLD$SYM; 

end; 

ELSE IF STACK$ LEVEL >= NEWSLEVEL THEN 

do; 

IF ( STACKSLEVEL = NEW$LEVEL ) AND (VALUE(MP) = 1) AND 
( ID$STACK( ID$STACKSPTR ) = REDEFSONE ) THEN 
CALL SET $ VALUED CLAUSE; 

DO WHILE NOT STACK$REDUCED ; 

SAVESSYM ,CURSSYM= IDS STACK ( IDS STACKS ?TR - 1); 

SAVESSYMSLVL = getSlevel; 

IF SAVE$SYM$LVL = STACK SLEV EL THEN 

do; 

CURSSYM = saveSsym; 
call redefStsst; 
end; 

ELSE IF (STACKSLEVEL >= NEW $ LEVEL ) AND 
(VALUE(MP) = 0) THEN 

do; 

DO while stackSlevel >= newSlevel; 

PATT P IT ’HTTP ^ T A P V • 

IF V ALUSSFLAG AND* (VALUESLEVSL=STACKSLEVEL) 

AND ( VALUESLEVEL = NEW$LE7EL ) THEN 

do; 

VALUESFLAG = FALSE; 

CALL sstSvaluesclause; 

EN D * 

end;/* do while loop */ 

STACK SREDUC ED = TRUE; 

end; 

ELSE IF (STACKSLEVEL >= NEW$LEVSL ) AND 
( VALUE (MP) = 1) THEN 

do; 

DO WHILE STACKSLEVEL > NEW$LSVEL; 

CALL reduceSstack; 

IF VALUESFLAG AND (VALUESLEVEL = STACKSLEVEL) 

THEN DO; 

valuesflag = false; 
call setsvaluesclauss; 
end; 

end;/* do while loop */ 
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STACK$REDUCED = TRUE; 

end; 

end;/* do while loop */ 
end; 

cur$sym = hold$sym; 
end check$lvl$work; 

CODE$GEN : PROCEDURE! PRODUCTION ) ; 

DECLARE PRODUCTION BYTE, 

LI T$TYPE BYTE; 

IF PRI NT$PROD THEN 

do; 

CALL cplf; 

CALL PRI NTGHAR (POUND ) ; 

CALL PR I NTi NUMBER (PRODUCTION ) i 

end; 

DO CASE production; 

/* PRODUCTIONS*/ 

/* CASE 0 NOT USED */ 

/* 1 <PROGRAM> ::= <ID-DIV> <E-DIV> <D-DIV> PROCEDURE */ 

do; 

compiling=false; 

DISPLAY (DISPLAY (0 )+l )= '$ 

CALL PR I NT ( . D I SPLAY ( 1 ) ); 

end; 

/* 2 < ID-DI V> ::= IDENTIFICATION DIVISION . PROGRAM-ID .*/ 
/* 2 <COMMENT> . <AUTH> <DATE> <SEC> */ 

*, /* NO ACTION REQUIRED */ 

/* 3 <AUTH> ::= AUTHOR . <COMMENT> . */ 

; /* NO ACTION REQUIRED */ 

/* A \! <EMPTY> */ 

; /* NO ACTION REQUIRED */ 

/* 5 <DATE> ::= DATE-WRITTEN . <COMMENT> . */ 

; /* NO ACTION REQUIRED */ 

/* 6 \ ! <EMPTY> */ 

J /* NO ACTION REQUIRED */ 

/* ? <SSC> ::= SECURITY . <COMMSNT> . */ 

; /* NO ACTION REQUIRED */ 

/* 8 \ ! <EMPTY> */ 

J /* NO ACTION REQUIRED */ 

/* 9 <COMMENT> : := <INPUT> */ 

; /* NO ACTION REQUIRED */ 

/*10 \ ! <COMMENT> <INPUT> */ 

J /* NO ACTION REQUIRED */ 

/*11 <E-DIV> ::= ENVIRONMENT DIVISION . CONFIGURATION */ 
/*11 SECTION . <SRC-OBJ> <I-0> */ 

J /* NO ACTION REQUIRED */ 

/*12 < SRC-OB J> SOURCE-COMPUTER . <COMMENT> <DFBUG> .*/ 

/*12 OBJECT-COMPUTER . <COMMSNT> . */ 

J /* NO ACTION REQUIRED */ 
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/*13 <DEBUG> : := DEBUGGING MODE */ 

debugging=true; /* SETS a scanner toggle */ 

/*14 \! <EMPTY> */ 

J /* NO ACTION REQUIRED */ 

/*15 <I-0> ::= INPUT-OUTPUT SECTION . FILE-CONTROL . */ 

/*15 <FI LE-CONTROL-LIST> <IC> */ 

J /* NO ACTION REQUIRED */ 

/*16 \ ! <EMPTT> */ 

J /* NO ACTION REQUIRED V 

/*17 <FI LE- CONTROL -L IST> : := <FI LE-CONTROL-ENTRY> */ 

J /* NO ACTION REQUIRED */ 

/*18 \! <?I LS-CONTROL-LI ST> */ 

/*18 <FILE-CONTROL-ENTRY> */ 

J /* NO ACTION REQUIRED */ 

/*19 <FILE-CONTROL-ENTRY> ::= SELECT <ID> 

<ATTRIBUTE-L IST> . */ 

CALL set$file$attrib; 

/*20 <ATTRI BUTE-LI ST> : := <0NS-ATTRI3> */ 

; /* NO ACTION REQUIRED */ 

/*21 \! < ATTRIBUTE -LIS T> <ONE-ATTRIB> V 

VALUE(MP)=VALUE(SP) OR VALUE(MP); 

/*22 <ONE-ATTRIB> ::= ORGANIZATION <ORG-TYPE> */ 
VALUE(MP)=VALUE(SP) J 

/*23 \ ! ACCESS <ACC-TYPE> <RELATI 7E> */ 

value ( mp ) = v alue ( mppi ) or value(sp); 

/*24 \ ! ASSIGN <INPUT> V 

CALL build^fcb; 

/*25 <ORG-TYPE> : := SEQUENTIAL */ 

J /* NO ACTION REQUIRED - DEFAULT V 
/*26 \ ! RELATIVE */ 

CALL OR $VALUE ( SP ,4 ) > 

/*27 <ACC-TYPE > SEQUENTIAL *7 

/* NO ACTION REQUIRED - DEFAULT */ 

/*28 \ ! RANDOM */ 

CALL OR^VALUE (SP ,2) * 

/*29 <RELATIVE> ::= RELATIVE <ID> V 

CALL OR$ V ALUE ( MP ,8 ) > 

/*30 \ ! <EMPTY> */ 

; /* NO ACTION REQUIRED - DEFAULT V 
/*31 <IC> : := I-O-CONTROL . <SAMS-LIST> */ 

/*32 \ ! <EMPTY> */ 

/*33 <SAME-LIST> ::= <S AMS-ELEMENT> */ 

/*34 \ ! <S AME-LI ST> <SAMS-ELEMENT> */ 

f 

/*35 <SAME-ELEMENT> : := SAME <ID-STRING> . V 
/*36 <ID-STRING> ::= <ID> */ 

/*37 \ ! <1 D-STR I NG> <ID> */ 
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/*38 <D-DIV> : := DATA DIVISION . <FILE-SECTION> <VORK> */ 
/*38 <LI NK> */ 

; /* NO ACTION REQUIRED */ 

/*39 <FILE-SECTION> ::= FILE SECTION . <FILE-LIST> */ 

FI LE$SEC$END = TRUE; 



7*40 


\ ! <EMPTY> */ 




file$sec$end=true; 




7*41 


<FILE-LIST> ::= <FILES> 


*/ 


; /* 


NO ACTION REQUIRED */ 




/*42 


\! <FILE-LIST> <FI LES> 


*/ 


; /* 


NO ACTION REQUIRED */ 




/*43 


<FI LES > FD <ID> <?ILE- 


CONTROL> 


7*43 


<RECORD-DESCRIPTION> 


*7 


do; 






do 


WHILE STACK$LEVEL > 1J 





CALL REDUCE$STACK» 
end; 

CALL end$cf$record; 

REDEF=FALS S; 

end; 

/*44 <FILE-CONTROL> : := <FILE-LIST> */ 

call set£io$addrs; 

/*45 \ ! <EMPTY> */ 

CALL set$io$addrs; 

/*46 <?I LE-L IS T> ::= <F ILE-ELEMENT> */ 

J /* NO ACTION REQUIRED */ 

/*47 \! <F ILE-LI ST> <FI LE-ELEMENT> */ 

5 /* NO ACTION REQUIRED */ 

/*48 <FI LE-ELEMENT> : := BLOCK <INTEGER> RECORDS */ 
J /* NO ACTION REQUIRED - FILES NEVER BLOCKED */ 
7*49 \ ! RECORD <REC-COUNT> */ 



CALL SET$S LENGTH (VALUE ( SP ) ) ; 

/*50 \! LABEL RECORDS STANDARD */ 

J /* NO ACTION REQUIRED */ 

/*51 \! LABEL RECORDS OMITTED */ 

; /* NO ACTION REQUIRED */ 

/*52 \! VALUE OF <ID-STRING> */ 

J /* NO ACTION REQUIRED */ 

7*53 <REC-COUNT> : :« <INTEGER> */ 

; /* NO ACTION REQUIRED - VALUE(SP) CORRECT */ 
/*54 \! <INTEGER> TO <INTEGER> */ 

do; 



VALUE(MP)=VALUE(S?) ; /* VARIABLE LENGTH */ 

CALL SET$TYPE(4); /* SET TO VARIABLE */ 

end; 

/*55 <WORK> ::= WORKING -STORAGE SECTION . */ 

/*55 <RECORD-DESCRIPTION> */ 

do; 

DO WHILE STACKiLEVEL > 1J 

CUR$ SYM = ID$STACK(ID5STACK$PTR - 1); 

IF GET $LEVEL = STACK$ LEVEL THEN 
CALL redef$test; 

ELSE IF STACK$LEVSL > 1 THEN 
CALL REDUCESSTACK; 
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end; 

IF STACK$LEVEL = 1 AND ID$STACK$PTR <> 0 THEN 

do; 

CURiSYM = IDiSTACK ( ID$STACK$?TR - 1); 

IF REDEF THEN CALL REDEF^TEST; 

end; 

CALL END$OF$RECORD5 

end; 

/*56 \ ! <EMPTY> */ 

; /* NO ACTION REQUIRED */ 

/*57 <LI NK> ::= LINKAGE SECTION . <RECORD-DSSCR IPTION> */ 
CALL PRI NT $ ERROR ( 'NI ' ) ; /* INTER PROG COMM */ 

/*5Q \! <EMPTY> */ 

; /* NO ACTION REQUIRED */ 

/*59 <RECORD-DESCRIPTION> ::= <LEV EL-ENTR Y> */ 

; /* NC ACTION REQUIRED */ 

/*6 0 \! <RECORD-DES CR I PTION> */ 

/*60 <LEVSL-ENTRY> */ 

; /* NO ACTION REQUIRED */ 

/*61 <LEVEL-ENTRY> ; := <INTEGE?.> <D ATA-ID> <REDSFINES> */ 
/*61 <DATA-TYPE> . */ 

do; 

call load$level; 

IF (PENDING$LITERAL <> 0) AND (NOT 7ALUE$FLAG ) THEN 
PENDING$LIT$ID = ID$ ST ACK$ PTR J 

end; 

/*62 <DATA-ID> : := <ID> */ 

J /* NO ACTION REQUIRED */ 

/*63 \ ! FILLER */ 

do; 

CUR$S YM , VALUE(SP)=NEXT$SYM; 

CALL BUI LD$ SYMBOL (0) ? 

end; 

/*64 <RSDE? INES> ::= REDEFINES <ID> */ 

do; 

CALL SET$ REDEF ( VALUE ( S P ) , VALUE ( S P-2 ) ) 5 
VALUE ( MP )=1 ; /* SET REDEFINE FLAG ON */ 

IF NOT FILE$SEC$END THEN 
CALL PRI NT$ ERROR ( '33') 5 
CALL CHECKS LVL$ WORK? 

end; 

/*65 \! <EMPTY> */ 

do; 

IF NOT FILEiSECiEND THEN 
CALL CHECKiLVL'pFILES; 

ELSE CALL CHE CK $LVL$ WORK J 

end; 

/*66 <DATA-TYPE> = <PF.O?-LIST> */ 

J /* NO ACTION REQUIRED */ 

/*67 \ ! <EMPTY> */ 

J /* NO ACTION REQUIRED */ 

/*68 <PROP-LIST> ::= <DATA-ELSMENT> */ 

; /* NO ACTION REQUIRED */ 

/*69 \ ! <PROP-LIST> <DATA-3LSMENT> */ 
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; /* NO ACTION REQUIRED */ 

/*70 <DATA-ELEMFNT> ::= PIC <IN?UT> */ 

CALL PICSANALIZER; 

/* 71 \! USAGE COMP */ 

CALL SETSTYPE(COMP) J 
/*72 \ ! USAGE DISPLAY */ 

; /* NO ACTION REQUIRED - DEFAULT */ 

/*73 \! SIGN LEADING <SEPARATS> */ 

CALL SET$SIGN (17) ; 

/*74 \ ! SIGN TRAILING <SEPARATE> */ 

CALL SET$S IGN ( 13 ) » 

/*75 \! OCCURS < I NT EGER > */ 

do; 

CALL OR$TYPE( 123) ,* 

CALL SET$OCCURS ( VALUE ( SP ) ) J 

end; 

/*76 \ ! SYNC <DI RECTI ON> */ 

; /* NO ACTION REQUIRED - BYTE MACHINE */ 
/*77 \! VALUE <LITERAL> */ 

do; 

IF NOT FILERS ECSEND THEN 

do; 

CALL PRINT$SRROR( 'VE' ) J 
PEND I NG$LITERAL=0 ; 

end; 

end; 

/*78 <DIRECTION> LEFT */ 

J /* NO ACTION REQUIRED */ 

/*79 \ ! RIGHT */ 

J /* NO ACTION REQUIRED */ 

/*80 \ ! <EMP‘TY> */ 

? /* NO ACTION REQUIRED */ 

/*81 <SSPARATE> ::= SEPARATE */ 

VALUE (SP) =25 

/*82 \ ! <EMP?Y> */ 

; /* NO ACTION REQUIRED */ 

/*83 <LI TERAL> : := <INPUT> #/ 

do; 

I? ( (LIT$TYPE:=GET$TYPE) <> 16) AND 
( LIT^TYPE <> 17) AND (L IT$TY?E <> 21) THEN 

do; 

CALL PRINTS ERROR ( 'NV' ) ; 

CALL LOAD$LI?ERAL(0); 

PENDINGSLITERAL = 2 ; 

end; 

else do; 

CALL LOAD$L ITER AL ( 1 ) 5 

pendingsliteral = i; 
end; 
end; 

/*84 \ ! <LIT> */ 

do; 

CALL LOAD $L ITER AL ( 0) J 
PEND I NG$LITERAL=2 J 
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end; 

7*85 \! ZERO */ 

PENDING $L ITER AL=3 » 

/*B6 \! SPACE */ 

PENDINGiLITSR AL=4J 

/*8? \! QUOTE */ 

PENDI NG $LI TERAL=5 ; 

/*88 <INTEGER> : := <INPUT> */ 

CALL CONVERT^ INTEGER? 

7*89 <ID> : := <INPUT> */ 

VALUE(SP)=MATCH; 7* STORE SYMBOL TABLE POINTERS */ 



END; /* END OF CASE STATEMENT */ 

END code$gen; 

GETIN1: PROCEDURE BYTE; 

RETURN INDEX1 (STATS) J 
END GETINi; 

GETIN2: PROCEDURE BYTE; 

RETURN I NDEX2 (STATE ) 5 
END GETIN2J 

INCSP : procedure; 
s?=sp + l; 

IF SP >= PSTACKSIZE THEN CALL FATAL$SRROR ( 'SO ' ) J 
VALUE (SP )=0; /* CLEAR VALUE STACK */ 

END INCSP; 



DUPilDEN^FLAG : PROCEDURE; 

IE TOKEN = 02 THEN FI LE$DESC$FLAG = TRUE; 
IF TOKEN = 47 TEEN REDEF^FLAG = TRUE; 

END DUP$IDEN$FLAGf 

LOOKAHEAD: PROCEDURE; 

IF NCLOOK THEN 

do; 

call scanner; 

call dup$iden$flag; 

nolook=false; 

IF PRI NT$TOKEN THEN 

do; 

CALL CELT J 

call print$number(tokin ) ; 

CALL PRINT$CHAR( ' ' )*, 

call print$accum; 
end; 
end; 

end lookahead; 

NO$CONELICT: PROCEDURE ( C STATE ) BYTE; 

declare (cstate , i , j ,k ) byte; 
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J=INDEX1(CSTATE); 

K= J + I NDEX2 ( CSTATE ) - l; 

DO I=J TO k; 

IF RE ADI ( I ) =TOKEN THEN RETURN TRUE; 

END; 

RETURN FALSE? 

end no$conflict; 

RECOVER: PROCEDURE BYTE; 

DECLARE ( TSP , RSTATE ) BYTE » 

do forever; 
tsp=sp; 

DO WHILE TSP <> 255; 

IF NO$CONFLICT(RSTATE:=STATESTACK(TS?) ) THEN 
DO; /* STATS WILL READ TOKEN */ 

IF SPOTS? THEN SP = TSP - l ; 

RETURN RSTATEJ 

end; 

TSP = TSP - 1 ; 

end; 

CALL SCANNER; /* TRY ANOTHER TOKEN */ 

end; 

end recover; 
end$pass : procedure; 

/* THIS PROCEDURE STORES THE INFORMATION REQUIRED BY 
PART2 IN LOCATIONS ABOVE THE SYMBOL TABLE. TEE FOLLOWING 
INFORMATION IS STORED: 

OUTPUT FILE CONTROL BLOCK 
COMPILER TOGGLES 
INPUT BUFFER POINTER 

THE OUTPUT BUFFER IS ALSO FILLED SO TEE CURRENT RECORD. 
IS WRITTEN */ 

CALL BYTS$OUT (SCD) ; 

CALL ADDRSOUT ( NEXT$A VA ILA3LE ) * 

DO WHILE OUTPUT £ PTRO . OU T PUT $ BUFF »* 

CALL BYTS$OUT(0F?H); 

end; 



CALL MOVE ( . OUTPUT $FCB , MAX £ MEMORY-PASS liLEN ,P.iSSl$LEN ) : 
L: GO TO L; /* PATCH TO "JMP 3100E ' */ 

END END$PASS; 

/* * * * * PROGRAM EXECUTION STARTS HSPE * * */ 

CALL MOVE(INITIAL$POS ,M AX ^MEMORY ,RDR$ LENGTH ) ; 

CALL INITiSCANNERJ 
CALL init$symbol; 



/£ 5jt # # £ # # * * # if. S}C £ / 

DO WHILE compiling; 
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IF STATE <= MAXRNO THEN /* READ STATE */ 

do; 

CALL INCSP; 

STATESTACK ( SP ) = STATE,* /* SAVE CURRENT STATE */ 
CALL lookahead; 

I-GETIN1? 

J - I + GET IN2 - l; 

DO 1=1 TO j; 

IF READ1(I ) = TOKEN THEN 

do; 

/* COPT THE ACCUMULATOR IF IT IS AN INPUT 
STRING. IF IT IS A RESERVED WORD IT DOES 
NOT NEED TO BE COPIED. */ 

IF (TOKEN=lNPUT$STR) OR ( TOKEN=L I TERA L ) THEN 
DO K=0 TO ACCUM(0); 

VARC(K ) = ACCUM(K ); 

end; 

STATE=RSAD2( I ); 

nolook=true; 

i=j; 

end; 

ELSE 

IF I=J THEN 

do; 

CALL PRI NT$ ERROR ( ' NP ' ) ; 

CALL PRI NT ( A' ERROR NEAR $'))? 

CALL PRINTS AC CUM? 

IF ( STATE : =RSCOVER )=0 THEN COMPILING=FALSEJ 

end; 

end; 

END; /* END OF READ STATE */ 

ELSE 

IF STATE>MAXPNO THEN /* APPLY PRODUCTION STATE */ 

do; 

MP=S? - GET IN2J 

mppi=mp + 1 ; 

CALL CODE$GEN( STATS - MAXPNO); 

SP=MPJ 
I=GET I N 1 J 
J=STATESTACK(SP) ; 

DO WHILE (K: = AP?LY1( I) ) <> 0 AND JOKI 

1=1 + 1; 
end; 

IF (K :=A??LT2( I ) )=0 THEN COMPILI NG=FALSE5 

state=k; 

end; 

else 

IF STATE<=MAXLNO THEN /^LOOKAHEAD STATE*/ 

do; 

I =GETI N 1 5 

CALL lookahead; 

DO WHILE ( K :=LOOKl ( I ) )<>0 AND TOKEN <>I; 

1 = 1 + 1 ? 

end; 



192 



STATE=L00K2( I ); 

end; 

ELSE 

do; /*push states*/ 

CALL INCSP; 

STATE STACK (SP)=GETIN2; 
STATE=GETINi; 

end; 

END? /* CE VHILS COMPILING */ 
CALL END $PASS J 

end; 



193 



PART2 : /* MODULE NAME */ 

do; 

/* COBOL COMPILER - PART 2 */ 



/* 100H = MODULE LOAD POINT */ 

/* GLOBAL DECLARATIONS AND LITERALS */ 



DECLARE LIT LITERALLY 'LITERALLY'; DECLARE 
PASS 1$ LEN LIT '48', 

MAX$MEMORY LIT '0D100H', 

?ASSl$TOP LIT '0D000H ' , 

CR LIT '13', 

LE LIT '10', 

QUOTE LIT '27H ' , 

POUND LIT '23H ' , 

TRUE LIT '1 ' , 

FALSE LIT '0 

FOREVER LIT 'WHILE TRUE', 

ALPHA$ LIT $FLAG BYTE I NI TI AL( FALSE ) , 

IFiFLAG 3YTE IMITIAL( FALSE ) J DECLARE MAXRNC LITERALLY 
'82',/* MAX READ COUNT */ 

MAXLNO LITERALLY '105',/* MAX LOOK COUNT */ 

MAXPNO LITERALLY '120',/* MAX PUSH COUNT */ 

MAXSNO LITERALLY '218',/* MAX STATE COUNT */ 

STARTS LITERALLY 'l';/* START STATE */ 

DECLARE READ1 ( *) 3YTE 

DAT A (0,63, 5, 6, 9, 14, 16, 20, 22, 24, 26, 31 ,32,41,42,44,45 ,49,53 



,54,58,60,48,28,48,29,28,29,36,37,48,59,11,35.46 
,34,13,28,29,36,37 , 48 , 3 , 1 , 40 , 23 ,48 , 57 , 1 , 56 , 2 , 30 ,43 , 27 , 1 9 

,33,50,52,64,18,4,38,28,39,48 ,61,55,1,15,7,12,10,51,5.9 

,14,16,20,22,24,26,31,41,42,44,45,49,53,54 
,58,60,51,7,17 ,1,1 

,5,9,14,16,20,21,22,24,26,31,41,42,44,45,49,53,54 
,54,58,60,46,62,8,48,25,0,0) ; 

DECLARE LCOK1 ( *) 5YTE 

DATA (0,43, 0,4 0,0, 2, 0,40,0, 1, 15,0,46,0,30,43,0,2,0,27 ,0,7 
, 3, 17, e, 1,15, 0.55, 0,55, 0,55, 0,55, 0,1, 15, 0,12, 0,1, 0,5 1,0 
,48,0); ,0,25,0,3,48 
DECLARE APPLY 1(*) BYTE 

D ATA (0,0, 22, 0,6, 0,0, 77, 0,0, 81 ,0,11,66,68,74,79,0,0.3,31 ,0 
,3,91 ,0,25,0,0 ,0,0,57,58,59,0,0,0,0,0,0,0 ,69,0,0,0,0,0,0 
,5,7,8,13,14 ,44,0,0,2,5,6,7,3,12,13,14,18.21,23,24, 

, 27 , 28 , 29 , 33 , 3 4 , 40 , 44 , 7 5 , 76 ,77,80,0,9,30,37,33,49,52, 

,0,5, 7, 8, 13, 14, 2 8, 44, 0,52, 0,20, 0,0, 15, ,32, 53, 65, 0,0,0, 

81,0,0); 



DECLARE EEAD2 ( * ) BYTE 

DATA (0 ,41 ,6 ,213,9,10,83,15 ,17,13,20,23,24 ,27 ,29,29,30,32 
,33,34,37,39,31,201,35,84,201,205,207,206,85, 178, 194.192 
,193,185 ,172,210,205,207, 206 ,239,202,129,25,191 

,197,86,3,35,4 ,199,188,21 ,167 ,168,156,161,162.14,5 

,191,201 ,25,35 ,39,169,2,11,7,164,174.134,6,9,10 ,83 



, 15, 1?, 18, 20, 23, 27, 28, 29, 30, 32, 33, 34, 37, 38, 184, 8, 13, 130 
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G) (J» /O 



,131 ,6 ,9 ,12 ,83,15,16 ,17 ,18 ,20 ,23,27 ,28,29,32 

,32,33,34,37,38,19,8,40,121,198,19,0,0); 

DECLARE LC0K2 ( *) BYTE 

DATA (0, 12,106 ,22,107,198 ,199,36,108,142,142,124,44,109,45 
,45,110,46,196 ,47,111,112,49,113,52,114,114,54,56, 115,57 
,116, 58 ,117,59,118 ,119,119,63,64,120,147,67,59,139,75 

,122,78,136 ,128,128,81) J 
DECLARE APPLY2 (* ) BYTE 

DATA (0,2, 137 ,60,76,103 ,77,127,126,105,73,72,151.150,152 
,177,149,132,133,104,104,136,102 ,102,139,182,74,160,48 
,65,155,153 ,156,154, 148,68,134,61,94, 146.66,173 

,79,159,55,186,80 ,96,144,97,98 ,95,175,135,190,42,90 

,87,90,90,215,90,90,217 ,179,138,38,124,89,90 ,157,91 

,158, 143,90,125,125,42,145,43,92,50 ,51,93,223,203,53,211 
,195, 195 ,195,195,195,195,195,202,71 ,70 ,208 ,212 , 171 , 62 
,99,213,163 ,130 , 140 , 141 , 101 , 1 01 ,147,82) J 
DECLARE I NDEX1 ( * ) BYTE 



DATA (0,1, 115, 2, 22, 115, 11 5, 11 5, 115, 23 ,25,73,115,115,115, 
,26,31 ,32 ,115 ,35,36,115 ,44, 115,115,26,115, 115,115,115 
,23,42,26,115 ,115,43,44,23,23,45,115,47 

,48,50,115,51 ,50,53,54,23 ,59,60,23,61 ,62,65, ,66,66,66 

,66,67,68,69 ,26,72,26,73,71 ,73 ,91 ,92,93,94 ,95,96,115,115 ,117 
,119,73,115,2,26,1,3,5,7,9,12,14,17,19,21,23.25,23,30,32 



,34,36,39, ,41,43,45,47,49,216,123,123,176 

,187,180,204,204,183,170,170,170,170 ,214,165,1,2 

,2,4,4,6,6,7,7,9,9,10,10,10,12,12.12,12,12,12,12,12,12,12, 
,12,12,12,12,18 ,18,18,18, 19,19, 19,19,22 ,22,22,25,27,27,27 
,28,28,29,29 ,29,30,30,34,34,35,35,36,36,37,37 ,38 

,38,39,39,39,40,42,43,43,44,44 ,45,45.46.46,46,47 

,47,54,55,80,80,80,88,96,96,98,98,98,100,100,130 
,101,101 ,106,106,107,107,108,111); 

DECLARE I NDEX2 (* ) BYTE 

DATA (0,1, 1,20, 1,1, 1,1, 1,2, 1,18, 1,1, 1,5, 1,3, 1,1, 6, 1,1,1, 

, 5 , 1 , 1 , 1 , 1 , 2 , 1 , 5 , 1 , 1 , 1 , 1 , 2 , 2 , 2 , 1 , 1 , 2 , 1 , 1 , 2 , 1 , 1 , 5 . 2 , 1 , 1, 2 

,1,3,, 1,1,1 ,1,1,1,1,1,5,1,5,13,2,18,1,1.1,1,1,19 

,1,2, 2,1, IS, 1,20, 5, 2, 2, 2, 2, 3, 2, ,3, 2, 2, 2, 2, 3. 2 

,2, 2, 2, 3 ,2,2,2 ,2,2,3,12 ,22,36,44,45,47,49,52,54,56,57, 
,58,59,63,64,5,1,0,0,1,0,1,2,2,1,2,0,0,2,1,0,2,1,0,2,1,1 
,3, 3, 2, 3, 0,1, ,2, 2, 4. 2, 5, 4, 4. 5, 1,1, 2, 2.0 

, 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 1 , 1 , 0 , 1,1 
, 0 , 0 , 1 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , 0,0 

,0,0, 0,0, 0,0 ,1,0); 



/* END 07 TABLES */ 

D ^ CL A.R E 

/** JOINT DECLARATIONS */ 

/* THE FOLLOWING ITEMS ARE DECLARED TOGETHER IN THIS 
GROUP IN ORDER TO FACILITATE THEIR 3ZING PASSED FROM 
THE FIRST PART OF THE COMPILER. 

V 

OUTPUT £FCB (33) BYTE, 

DEBUGGING BYTE, 

PRINTS PROD BYTE, 

PRINT$TOKEN BYTE, 
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L IST$I NPUT BYTE, 

SEQ^NUM BYTE, 

NEXT$SYM ADDRESS , 

POINTER ADDRESS, /* POINTS TO THE NEXT BYTE 

TO BE READ */ 

NEXT$AVAILABLE ADDRESS, 

MA.X$INT$MEM ADDRESS, 

HASH$TAEi ADDR ADDRESS, /* ADDRESS OE THE BOTTOM OF 

THE TA3LES FROM PARTI */ 



/* I 0 BUFFERS AND GLOBALS */ 
IN^ADDR ADDRESS INITIAL ( 5CH) , 

I NPUTFCB BASED IN ADDR (33) BYTE, 
OUTPUT $BUFF (128) BYTE, 

OUTPUT $?TR ADDRESS, 

OUTPUTSEND ADDRESS, 

OUTPUT $CHAR BASED OUTPUT$PTR BYTE; 



/* MESSAGES FOR OUTPUT */ 

DECLARE 

ERROR$ NEAR $ $ (*) BYTE DATA (' ERROR NEAR $'), 
END$0FSPART$2(*) BYTE DATA ( ' END OF COMPILATION $'/; 

/* GLOBAL COUNTERS */ 

DECLARE 
CTR BYTE, 

ASCTR ADDRESS, 

BASE ADDRESS , 

3^BYTE BASED BASE BYTE, 

B$ADDP. BASED BASE ADDRESS » 

MON1 : PROCEDURE ( F , A ) EXTERNAL; 

DECLARE F BYTE, A ADDRESS; 

END MON 1» 

M0N2 : PROCEDURE ( F , A ) BYTE EXTERNAL; 

DECLARE F BYTE, A ADDRESS J 
END M0N2 5 



BOOT: PROCEDURE EXTERNAL; 

END boot; 

PRINTCHAR: PROCEDURE (CHAR); 
DECLARE CHAR BYTE; 

CALL MON1 (2 , CHAR) J 
END PRINTCHAR; 



CRLF: PROCEDURE; 

CALL PRINTCHAR ( CR ) 5 
CALL PRINTCHAR ( LF ) ; 
END CRLF? 

PRINT: PROCEDURE (A); 
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DECLARE A ADDRESS? 

CALL MON 1 (9,A)J 
END print; 

PR I NT £ ERROR : PROCEDURE (CODE); 

/* THIS PROCIDURE IS USED TO PRINT COMPILER ERRORS TO 
THE CONSOL */ 

DECLARE CODE ADDRESS, 

I BYTE, 

CODE1 ( 6 ) address; 

IF CODE = FALSE THEN 

do; 

DO I = 0 TO 5; 

codeki ) = 0 ; 
end; 

1 = 0 ; 

end; 

ELSE 

IF CODE = TRUE THEN 
DC? 

i = 0; 

DO WHILE((I<>6) AND (CODEl(I) <> 0)); 

CALL crlf; 

CALL PRINTCEAR(HIGE( CODElt I) ) )? 

CALL PRINTCHAR ( LOW ( CODS1 ( I ) ) ) ; 

CODEKI ) = 0 ; 
i = i '+ i; 

end; 
i = 0 ; 
end; 

ELSE 

IF (CODE = 'NP') OR (CODS = 'NV') OR (CODE = 'SL') THEN 

do; 

CALL CRLF; 

CALL PRINTCHAR (HIGH (CODE ) ) ; 

CALL PRINTCHAR ( LOW(CODE)); 

end; 

ELSE 

do; 

IF I <> 6 TEEN 

do; 

CODEl( I ) = code; 
i = i + i; 
end; 
end; 

end printserror; 

FATAL$ERROR: PROCEDURE ( REASON ) ; 

DECLAPS -E AS ON ADDRESS? 

CALL PRI NT$ERROR (REASON ) ? 

CALL PRINT$ERR0R( TRUE ) ? 

CALL TIME(10)J 
CALL eoot; 
end fatal^errcr; 
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CLOSE: PROCEDURE; 

IE M0N2( 16, .0UTPUTiFCB)=255 THEN CALL FATAL $ERROR ( 'CL ' ) 

END close; 

MORE$ I NPUT : PROCEDURE BYTE? 

/* READS THE INPUT FILE AND RETURNS TRUE IF A RECORD 
WAS READ. FALSE IMPLIES END OF FILE */ 

DECLARE BCNT BYTE 5 

IF ( DC NT : =MO N2 (20, . IN PUTiFCB ) )>1 TEEN 
CALL FA T A Li ERROR ( 'BR ' ) ; 

RETURN NOT(DCNT); 

END MOREil NPUT J 



WR I TE$OUTPUT : PROCEDURE (LOCATION); 

/* WRITES OUT A 128 BYTE 3UFFER FROM LOCATION 515 / 

DECLARE LOCATION ADDRESS; 

CALL MON1 (26, LOCATION ) J /* SET DMA */ 

IF MON 2 ( 21 , .CUTPUTiFCB)<>0 THEN CALL FATALiERROR ( 'WR ' ) J 
CALL MON1 ( 26 ,80H ) * /PRESET DMA */ 

END write$output; 

MOVE: PR OCE DU RE (SOURCE, DESTINATION, COUNT); 

/* MOVES FOR THE NUMBER OF BYTES SPECIFIED BY COUNT */ 
DECLARE (SOURCE, DESTINATION ) ADDRESS, 

( S$BYTE BASED SOURCE, DiBYTE BASED DESTINATION, COUNT) 
BYTE ? 

DO WHILE ( COUNT :=CCUNT - 1 ) <> 255; 

DiBYTE=Si3YTS; 

SOURCE= SOURCE + 1J 
DESTINATION = DESTINATION + 1J 

end; 

END move; 



FILL: PROCEDURSUDDR .CHAR, COUNT) ; 

/* MOVES CHAR INTO ADDR FOR COUNT BYTES */ 
DECLARE ADDR ADDRESS, 

( CHAR, COUNT ,DEST BASED ADDR) BYTE J 
DO WHILE ( COUNT :=COUNT -1)0255; 

dest=cear; 

ADDR=ADDR + l; 
end; 

end fill; 



/* * * * * * SCANNER LITS 555 5(5 



DECLARE 



LITERAL 


LIT 


'29', 


INPUTiSTR 


LIT 


'48', 


PERIOD 


LIT 


'1 \ 


P. PAR IN 


LIT 


'3', 


LPARIN 


LIT 


'2', 


INVALID 


LIT 


'a'; 



*/ 



/* * * * * SCANNER TABLES 5)5 * 555 * * / 
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DECLARE T0KEN$TA3LE (*) BYTE DATA 

/* CONTAINS THE TOKEN NUMBER ONE LESS THAN THE FIRST 
RESERVED WORD FOR EACH LENGTH OF WORD */ 
(0,0,3,7,13,29,41,48, 56,60,63) , 



TABLE (*) BYTE DATA ( 'BY ' , 'GO ' , 'I F' , 'TO ' , ' EOF ' , ' ADD ' , ' END ‘ 
, 'I-O' , 'NOT ', 'RUN' , 'CALL' , 'ELSE ' , 'EXIT', 'FROM' , 'INTO 

, 'LESS ' , 'MOVE ' , 'NEXT' , 'OPEN ' , 'PAGE', 'READ', 'SIZE', 'STOP ‘ 

, 'THRU', 'ZERO' , 'AFTER', 'CLOSE', 'ENTER', 'EQUAL', 'ERROR 

, 'INPUT' , 'QUOTE' , 'SPACE ' , 'TIMES ', 'UNTIL' . 'USING' , 'WRITE 

, 'ACCEPT', 'BEFORE', 'DELETE' , 'DIVIDE', 'OUTPUT', 'DISPLAY 

, 'GREATER' , 'INVALID', 'NUMERIC', 'PERFORM' , 'REWRITE' 

, 'ROUNDED' , 'SECTION ' , 'DIVISION ' , 'MULTIPLY ', 'SENTENCE 

, 'SUBTRACT' , 'ADVANCING' , 'DEPENDING ' , 'PROCEDURE 

, 'ALPHABETIC ' ) , 

OFFSET (11) ADDRESS INITIAL 

/* NUMBER OF BYTES TO INDEX INTO THE TABLE FOR 
EACH LENGTH */ 

(0,0,0,8,26,86,146,176,232,264,291) , 



WORD$ COUNT (*) BYTE DATA 

/* NUMBER OF WORDS OF EACH SIZE */ 
(0,0,4,6,15,12,5,8,4,3,1) , 



MAXfIDiLEN LIT '12', 

MAX5L3N LIT '10', 

ADD$ END (*) BYTE DATA ('EOF '), 

LOOKED BITE INITIAL (0) , 

HOLD BYTE, 

EOFFILLSR LIT 'l AH ' , 

SUFFERSEND ADDRESS INITIAL (100H), 

NEXT BASED POINTER 3YTE , 

INBUFF LIT '80H ' , 

CHAR BYTE INITIALS '), 

ACCUM (32) BYTE, 

DISPLAY (82) BYTE INITIAL (0), 

TOKEN BYTE; /^RETURNED FROM SCANNER */ 

/* PROCEDURES USED 3Y THE SCANNER */ 

NEXT$ CHAR : PROCEDURE EYTEJ 
IF LOOKED THEN 

do; 

looked=false; 

RETURN ( CHAR : = ECLD ) 5 

end; 

IF (POINTER :=POINTER + 1) >= BUFFERS END THEN 

do; 

IF NOT MORE* INPUT THEN 

do; 

BUFFER^END=. MEMORY; 

POINTER*. ADD$ENDJ 

end; 

else ?ointer=inbuff; 
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end; 

I? NEXT = EOFEILLER THEN 

do; 

BUFFER$END = .MEMORY; 

POINTER = ,ADD$END; 

end; 

RETURN (CHAR:=NEXT); 

END next$chaf.; 

GETiCEAR : PROCEDURE; 

/* THIS PROCEDURE IS CALLED WHEN A NEW CHAR IS NEEDED 
WITHOUT THE DIRECT RETURN OF THE CHARACTER*/ 

char=next$cear; 
end get$char; 

DIS PLAY $ LINE : PROCEDURE; 

IF NOT LI ST$ I N PUT THEN RETURN; 

DISPLAY (DISPLAY (0) + 1) = 

CALL PRI NT ( .DISPLAY ( 1 ) ) 5 
DISPLAY (0 )=0 ; 

END display$line; 

LOAD$DIS PLAY : PROCEDURE; 

IF DIS PLAY (0 )<£0 THEN 

DISPLAY (D IS PLAY (0 ) : = D ISPLAY ( 0 ) +1 )=CHAR; 

CALL GETiCEARJ 
END load$display; 

PUT: procedure; 

IF ACCUM{ 0 ) < 80 THEN 

ACCUM( ACCUM ( 0 ) :=ACCUM(0)+1)=CHAR; 

CALL LOADED I splay; 
end put; 

EAT$LI NE : PROCEDURE; 

DO WHILE CHAROCR5 
CALL LOAD$DISPLAY; 

end; 

end eat$line; 

GET$NO$BLANK: PROCEDURE; 

DECLARE ( N 1 1 ) BYTE; 

do forever; 

IF CHAR = ' ' THEN CALL LOADSDIS PLAY ; 

ELSE 

IF CHAR = C R THEN 

do; 

CALL displat$line; 

CALL PRlNTiERROR(TRUS); 

IF SEC^NUM THEN N=9J ELSE N=2J 
DO I = 1 TO n; 

CALL LCAD$ DIS PLAY? 

end; 

IF CHAR = THEN CALL EATS LI NE ; 
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THEN 



END ; 

ELSE 

IF CHAR * ' 

do; 

IF NOT DEBUGGING THEN CALL EAT$LINS; 

ELSE 

CALL load$display; 
end; 

ELSE 
RETURN > 

END; /* END CF DO FOREVER */ 

end get$no£blank; 

SPACE: PROCEDURE EYTE; 

RETURN ( CHAR= ' ') OR (CHAR=CR)5 

end space; 

LEFT$PARI N : PROCEDURE BYTE; 

RETURN CHAR = '('; 

END left$parin; 

RIGHT$PARI N : PROCEDURE BYTE; 

RETURN CHAR = 

END right$parin; 

DELIMITER: PROCEDURE BYTE; 

/* CHECKS FOR A PERIOD FOLLOWED BY A SPACE OR CR*/ 

IF CHAR <> THEN RETURN FALSE J 

hold=neit$char; 

looked-true; 

IF SPACE THEN 

do; 

CHAR = ' 

RETURN TRUE; 

end; 

CHAR*'. '; 

RETURN FALSE; 

END DELIMITER; 

SND$OF$TOKEN: PROCEDURE BYTE; 

RETURN SPACE OR DELIMITER OR LEFT$?ARIN OR RIGHT$?ARIN; 
END end$of$token; 

GET$L ITERAL : PROCEDURE 3YTE5 
CALL LOADED I SPLAY5 

DO forever; 

IF CHAR = QUOTE THEN 

do; 

CALL LOAD$DIS?LAY: 

RETURN LITERAL; 

end; 

CALL PUT; 

end; 

end get$literal; 
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LOOK-UP: PROCEDURE BYTE ; 

DECLARE POINT ADDRESS, 

HERE BASED POINT (1) BYTE, I BYTE ; 

MATCH: PROCEDURE BYTE; 

DECLARE J BYTE; 

DO J=1 TO ACCUM (0 ) J 

IE HERE ( J - 1) <> AC CUM ( J ) THEN RETURN FALSE; 

end; 

RETURN TRUE; 

end match; 

POI NT=OEFSET ( AC CUM ( 0 ) )+ .TABLE; 

DO 1=1 TO WORDiCOUNT(ACCUM(0)); 

IF MATCH THEN RETURN I; 

POINT = POINT + AC CUM ( 0 ) ; 

end; 

RETURN FALSE; 

END LOOK$UP; 

RESERVED$VORD: PROCEDURE BYTE; 

/* RETURNS THE TOKEN NUMBER OF A RESERVED WORD IF TEE 
CONTENTS OF THE ACCUMULATOR IS A RESERVED WORD, 
OTHERWISE RETURNS ZERO */ 

DECLARE VALUE BYTE; 

•DECLARE NUMB BYTE; 

I? ACCUM ( 0 ) <= MAX^LEN THEN 

do; 

IF (NUMB:=TOKSN$TAELS( ACCUM(0) ) )<>0 THEN 

do; 

IF ( VALUE:=LOOK$U?) <> 0 THEN 
NUMB=NUMB + VALUE; 

ELSE NUMB=0J 

end; 

end; 

ELSE NUM3=0; 

RETURN NUMB? 

END reservsd$word; 

GET$TOKEN: PROCEDURE 3YTEJ 
ACCUM ( 0 ) =0 ; 

CALL gst$no$blank; 

IF CHAR=OUOTE TEEN RETURN GET$LITERAL; 

IF DELIMITER THEN 

do; 

CALL put; 

RETURN PERIOD; 

end; 

I? LEFT$?ARIN THEN 

do; 

CALL put; 

RETURN LPARIN; 

end; 
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17 FIGHTiPAR IN THEN 

do; 

CALL put; 

RETURN RPAEIN; 

end; 

do forever; 
call put; 

IF END$OFiTOKEN THEN RETURN INPUT$STR; 

END; /* OF DO FOREVER */ 

END GETi TOKEN ; 

/* END OF SCANNER ROUTINES */ 

/* SCANNER EXEC */ 

SCANNER: PROCEDURE; 

IF(TOKEN:=GST$TOKEN) = INPUT$STR THEN 

IF ( CTR : =RESERVED$ WORD ) <> 0 THEN TOXEN=CTRJ 
END scanner; 

PRI NT$AC CUM : PROCEDURE; 

ACCUM(ACCUM(0)+1 )='$'; 

CALL PRINT ( . AC CUM ( 1 ) ) J 

END print$accum; 

PRINTS NUMBER : PROCEDURE ( NUMB ) ? 

DECLARE ( NUMB , I , CNT ,X) BYTE, J (*) 3YTS DATA(100,10) 
DO 1=0 TO i; 

CNT=0J 

DO WHILE NUMB >= ( £ : = J ( I ) ) J 
NUMB=NUMB - K; 

CNT=CNT + I? 

end; 

CALL PRI NTCEAR ( '0 ' + CNT ) ; 

end; 

CALL PRI NTCH AR ( '0 ' + NUMB); 



END printsnumbsr; 

/* * * * END OF SCANNER PROCEDURES * * * */ 

/* * * * * SYMBOL TABLE DECLARATIONS * * * */ 



DECLARE 

CUR$STM 


ADDRESS, /^SYMBOL BEING ACCESSED 34 '/ 


SYMBOL 


3 AS ED CUR$SYM (1) 3YTE , 


SYMBOL$ADDR 


BASED CUR$ S YM (1) ADDRESS, 


NEXTs SYM$ENTRY BASED NEXT$S YM ADDRESS, 


HASH^MASK 


LIT '3FH ' , 


S$ TYPE 


LIT '2', 


DISPLACEMENT 


LIT '13', 


OCCURS 


LIT '12'. 


P$LENGTH 


LIT '3', 


?LD$LENGTH 


LIT '3', 


LEVEL 


LIT '10', 


DECIMAL 


LIT '11', 


REL$ID 


LIT '5', 


LOCATION 


LIT '2 , 


START$NAME 


LIT '12', /*1 LESS*/ 


FC3$ADDR 


LIT '4', 


/# # # # 


341 * * SYMBOL TYPE LITERALS * * * 3)1 * * */ 


UNRESOLVED 


LIT '255', 


LA3EL$TYPS 


LIT '32', 
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MULT$OCCURS LIT 
GROUP LIT 

NON$NUMERIC?LIT LIT 
ALPHA LIT 

ALPHA$NUM LIT 

LIT?SPACE LIT 

LIT$QUCTE LIT 

LIT$ZERO LIT 

NUMERI C$ LI TER A L LIT 

NUMERIC LIT 

COMP LIT 




' 10 ', 

' 11 ', 

' 12 ', 

' 15 ' 




♦ 



A?ED LIT '72', 

A$N?ED LIT '73', 

NUMBED LIT '80'; 

/* * * * SYMBOL TABLE ROUTINES * * * 
SET$ADDRESS: PROCEDURS( ADDR ) 5 
DECLARE ADDR ADDPESSJ 

symbol$addr(location)=addr; 

END SST?ADDRESS5 



GET? ADDRESS : PROCEDURE ADDRESS » 
RETURN SYMBOL? ADDR (LOCATION ) ; 
END GET? ADDRESS *, 

GET?FCB? ADDR: PROCEDURE ADDRESS J 
RETURN SYMBOL? ADDR (FCB? ADDR ) ,* 

END get?fcb?addr; 

GET?TYPE : PROCEDURE 3YTE; 

RETURN SYMEOL(S?TYPE) ; 

END get?type; 

SETSTYPE: PROCEDURE( TYPE) ; 



V 



DECLARE TYPE BYTE; 

symbcl(s?type)=type; 
end set?type; 

GET?LENGTH : PROCEDURE ADDRESS; 

RETURN SYMB0L?ADDR(7LD?LENGTH) J 
END get?lsngte; 

GETSLEVEL: PROCEDURE BYTE; 

RETURN SYMBOL( LEVEL ) J 

END get?levsl; 

GET?DECI MAL : PROCEDURE BYTE; 

RETURN SYMBOL(DECIMAL); 

end get?decimal; 

GET?P?LENGTH: PROCEDURE BYTE; 

RETURN S YM30L ( P? LENGTH ) J 

END get?p?length; 

BUI LD?SYMBOL : PROCEDURE(LEN ) ; 

DECLARE LEN BYTE, TEMP ADDRESS 5 

temp=next?sym; 

IF (NEXT?SYM:=.SYMBOL(LEN :=LEN + DISPLACEMENT)) 
> MAX?MEMORY TEEN CALL FATAL?ERROR ( 'S T ' ) 5 
CALL FILL (TEMP, 0, LEN ); 

END build?symbol; 

AND?OUT? OCCURS : PROCEDURE (TYPS?IN) BYTE; 

DECLARE TYPE?I N BYTE? 

RETURN TYPE? IN AND 127; 
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END AND$ OUTiOCCURS » 

/* * * * PARSE? DECLARATIONS * * * */ 

DECLARE 

PS TACK SI ZE LIT '30', /* SIZE OP PARSE STACKS*/ 

VALUE (PSTACKSIZE) ADDRESS, /* TEMP VALUES */ 

STATESTACK (PSTACKSIZE) BYTE, /* SAVED STATES */ 



VALUE2 
V ARC 

ID$STACK 
ID$PTR 
MAX$BYTE 
SUB$I ND 
COND$TYPE 



(PSTACKSIZE) ADDRESS 



( 100) 

(20) 

BYTE , 

BASED 
BYTE 
BYTE, 

HOLDiSECTION ADDRESS, 
HOLDi SEC $ ADDR ADDRESS 



/* VALUE2 STACK*/ 



BYTE, 
ADDRESS , 



/*TEMP CHAR STORE*/ 



MAX$ I NT$MEM 
INITIAL (0), 



BYTE 



INITIAL 



INITIAL 



( 2 ), 

( FALSE) 



SEC TION$FLAG BYTE 
Li ADDR ADDRESS, 

DISPLAYiFLAG BYTE 
LiLENGTH ADDRESS, 

LiTYPE BYTE, 

LiDSC BYTE, 

CON$LENGTH BYTE, 

COMPILING BYTE I N ITI AL ( TRUE ) , 
SP BYTE INITIAL (255) , 



MP 

MPP1 
NOLOOK 
( I * J »K) 

STATE 

/* * * 

/* THE 
ON THE 
/* LENGTH 
ADD LIT '1', 
SUB LIT '2', 
MUL LIT 
DIV LIT 



BYTE, 
BYTE, 
BYTE 
BYTE, 
BYTE 
* * # £ 



INITIAL (FALSE ) , 

/*I NDI C IES FOR 
INITIAL (STARTS ) , 

* CODE LITERALS * 



THE PARSER*/ 



# £ a* # # if 



/ 



MEG LIT 
ST? LIT 
STI LIT 

/* LENGTH 
RND LIT '8', 
/* LENGTH 



CODE LITERALS ARE BROKEN INTO GROUPS DEPENDING 
TOTAL LENGTH OF CODE PRODUCED FOR THAT ACTION */ 
ONE */ 

/* ADD REGISTER 1 TO 
SUBTRACT REGISTER 
MULTIPLY REGISTER 
DIVIDE REGISTER 0 
(NO REMAINDER) */ 

NOT OPERATOR */ 

STOP PROGRAM */ 

STORE REGISTER 2 



'•* ' 



/* 

/* 

/* 



'5' 

' 6 ' 

'7' 



/* 

/* 

/* 

TWO 

/* 



REGISTER 0 */ 

1 FROM REGISTER 0 */ 
0 BY REGISTER 1 */ 

BY REGISTER 1 



INTO REGISTER 0 */ 



*/ 

ROUND 



CONTENTS OF REGISTER 2 */ 



THREE */ 



RET 


LIT 


'9', 


/* 


RETURN */ 


CLS 


LIT 


'10', 


/* 


CLOSE */ 


SSR 


LIT 


'll , 


/* 


BRANCH ON SIZE ERROR */ 


BRN 


LIT 


'12', 


/* 


BRANCH */ 


OPN 


LIT 


'13', 


/* 


OPEN A FILE FOR INPUT */ 


OP1 


LIT 


'U', 


/* 


OPEN A FILE FOR OUTPUT */ 


0P2 


LIT 


'15', 


/* 


OPEN A FILE FOR BOTH INPUT 


RGT 


LIT 


'16', 


/* 


REGISTER GREATER THAN */ 


RLT 


LIT 


'17', 


/* 


REGISTER LESS THAN */ 


REQ 


LIT 


'18', 


/* 


REGISTER EQUAL */ 



AND OUTPUT */ 
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IN V LIT '19' 
EOR LIT '20' 
/* LENGTH 



ACC 


LIT 


'21 ' , 


/* 


ACCEPT */ 


STD 


LIT 


'22', 


/* 


STOP WITH DISPLAY */ 


LDI 


LIT 


'23', 


/* 


LOAD A CODE ADDRESS DIRECT */ 



/* LENGTH 



DIS 


LIT 


'24', 


/* 


DEC 


LIT 


'25', 


/* 


STO 


LIT 


'26', 


/* 


ST1 


LIT 


'27', 


/* 


ST2 


LIT 


'28' , 


/* 


ST3 


LIT 


'29', 


/* 


ST4 


LIT 


'30', 


/* 


ST5 


LIT 


'31 ', 


/* 


/* LENGTH ; 


SIX 


LOD 


LIT 


'32', 


/* 


LDI 


LIT 


'33 ', 


/* 


LD2 


LIT 


'34' , 


/* 


LD3 


LIT 


'35' , 


/* 


LD4 


LIT 


'36', 


/* 


LD5 


LIT 


'37', 


/* 


LD6 


LIT 


'38', 


/* 



/* LENGTH 
PER LIT '39' 
CNU LIT '40' 
CNS LIT '41' 
CAL LIT '42' 
RWS LIT '43' 
DLS LIT '44' 
RDF LIT '45' 
VTF LIT '46' 
RVL LIT '47' 
WVL LIT '48' 
/* LENGTH 



/* LENGTH 
RRS LIT '54' 
WRS LIT '55' 
RRR LIT '56' 
WRR LIT '57' 
RWR LIT '53' 
DLR LIT '59' 
/* LENGTH 
MED LIT '60' 
MNE LIT '61' 
/* VARIABL 
GDP LIT '62' 
/* BUILD 
INT LIT '63' 



/-BRANCH IF INVALI E-FILE-ACTION FLAG TRUE-/ 
/* BRANCH ON END-OF-PECORDS FLAG */ 

FOUR */ 



FIVE */ 

DISPLAY */ 

DECREMENT COUNT AND BRANCH IF ZERO */ 
STORE NUMERIC */ 

SIGNED NUMERIC LEADING */ 

SIGNED NUMERIC TRAILING */ 
SEPARATE SIGN LEADING */ 
SEPARATE SIGN TRAILING */ 

A PACKED NUMERIC FIELD */ 



STORE 
STORE 
STORE 
STORE 
STORE 
*/ 

LOAD 
LOAD 
LOAD 
LOAD 
LOAD 
LOAD 
LOAD 
SEVEN */ 

/* PERFORM 
COMPARE 
COMPARE 
COMPARE 
REWRITE 
DELETE 



NUMERIC LITERAL */ 

NUMERIC */ 

SIGNED NUMERIC LEADING */ 
SIGNED NUMERIC TRAILING */ 
SEPARATE SIGN LEADING */ 
SEPARATE SIGN TRAILING */ 

A PACKED NUMERIC FIELD */ 



/* 

/* 

/- 

/* 

/* 

/* 

/* 

/* 

/* 

NINE 



*/ 

NUMERIC UNSIGNED */ 
NUMERIC SIGNED */ 
ALPHABETIC */ 
SEQUENTIAL */ 
SEQUENTIAL */ 



READ A SEQUENTIAL FILE */ 

WRITE A RECORD TO A SEQUENTIAL FILS V 
READ A VARIABLE LENGTH FILE */ 

WRITE A VARIABLE LENGTH RECORD 
*/ 

*/ 



*/ 



SCR 


LIT 


'49 


✓ 


/* 


CALCULATE A SUBSCRIPT 


SGT 


LIT 


'50 


* 

t 


/* 


STRING 


GREATER THAN */ 


SLT 


LIT 


'51 


f 


/* 


STRING 


LESS THAN */ 


SEQ 


LIT 


'52 


* 


/* 


STRING 


EQUAL */ 


MOV 


LIT 


'53 


t 


/* 


MOVE * 


/ 



TEN */ 

/* READ RELATIVE SEQUENTIAL -/ 

/* WRITE RELATIVE SEQUENTIAL */ 

/* D E AD RELATIVE RANDOM */ 

/* WRITE RELATIVE RANDOM */ 

/* REWRITE RELATIVE */ 

/- DELETE RELATIVE */ 

ELEVEN */ 

/*MOVE INTO AN ALPHANUMERIC EDITED FIELD*/ 
/* MOVE INTO A NUMERIC EDITED FIELD */ 

E LENGTH */ 

/* GO TO - DEPENDING ON */ 

DIRECTING ONLY */ 

/* INITIALIZE MEMORY */ 
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3ST LIT '64', /* BACK STUFF */ 

TER LIT '65', /* TERMINATE BUILD */ 

SCD LIT '66'; /* START CODE */ 

/# * * * PARSER ROUTINES * * * * */ 

DIGIT: PROCEDURE (CHAR) BYTE? 

DECLARE CHAR BYTE; 

RETURN ( CHAR<= '9 ' ) AND (CHAR>='0'); 

END digit; 

LETTER: PROCEDURE (CHAR) BYTE? 

DECLARE CHAR BYTE? 

RETURN ( CEAR >= ' A ' ) AND (CHAR<='Z')J 

END letter; 

INVALID$TYPE: PROCEDURE; 

CALL PP.INT$5RR0R ( 'IT' ); 

END invalid$type; 

BYTEiOUT: PROC EDURE( ONE^BYTE ) ? 

DECLARE ONE$ BYTE 3 YTE ; 

IF ( OUTPUT$ PTR : =OUTPUT$PTR + 1) > OUTPUT^END THEN 

do; 

CALL WRITE$OUTPUT( .outputsbuff); 

OUTPUT$PTR=. OUTPUT $BUFFJ 

end; 

OUTPUT iCHAE-ONEiBTTE; 

END byte$out; 

ADDR$ OUT : PROCEDURE ( ADDR ) J 
DECLARE ADDR ADDRESS; 

CALL B YTE$OUT ( LOW ( ADDR ) ) ; 

CALL 3YTE$OUT (HIGH (ADDR)); 

END addrAout; 

INC$COUNT: PROCEDURE( CNT) ; 

DECLARE CNT BYTE; 

IF( NEXT$ AVAILABLE :=NEXT$ AVAILABLE + CNT) 

>MAX$INT$MEM THEN CALL FATAL$ ERROR ( 'MO ') J 
END incscount; 

ONE $ADDR$OPP : PROCEDURE ( CODE , ADDR ) J 
DECLARE CODE BYTE, ADDR ADDRESS; 

CALL BY'TEiOUT (CODE ) ; 

CALL A DDP.$OUT( ADDR ) J 
CALL INC$C0UNT(3) J 
END ONE$ADDRSOPP; 

NOT$I MPLIMENTED : PROCEDURE; 

CALL PRINT$ERR0R ( 'NI ') J 
END NOT$ IMPLIMENTED; 

MATCH: PROCEDURE ADDRESS J 

/* CHECKS AN IDENTIFIER TO SEE I? IT IS IN THE SYMBOL 
TABLE. IF IT IS PRESENT, CURASYM IS SET FOR ACCESS, 
OTHERWISE THE POINTERS ARE SET FOR ENTRY*/ 

DECLARE POINT ADDRESS, COLLISION BASED POINT ADDRESS, 
(HOLD, I) bite; 

IF VARC(0)>MAX$ID$LEN THEN V ARC ( 0 )=MAX$ ID$LIN J 
E0LD=8 ; 

DO 1=1 TO VARC(0); 

HOLD=HOLD+VARC( I ); 

end; 
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POINT=HASHATAEAADDR + SHL ( ( HOLD AND HASHSMASK ) , 1 ) 5 

do forever; 

IF COLLIS ION=0 THEN 

do; 

curasym ,collision=next$sym; 

CALL BUILDASYMBOL(7ARC(0) ) J 
SYMBOL ( P$ LENGTH) =VARC(0); 

DO 1=1 TO VARC(0); 

SYMBOL ( START$ NAME+I )=V ARC ( I ) ? 

end; 

CALL SETATYPE ( UNRESOLVED ) J /* UNRESOLVED LABEL */ 
RETURN CURASYM; 

end; 

ELSE 

do; 

cur$sym=collision; 

IF ( HOLD :=GETAP$LENGTH )=VARC (0 ) THEN 

do; 

1=1 ; 

DC WHILE SYMBOL(START$NAME + I )= VARC(I); 

IF ( I : = I +1 ) >HOLD THEN RETURN! CURA SYM :=CCLLI S ION ) ; 

end; 

end; 

end; 

?cint=collision; 

end; 

end match; 

SETAVALUE : PROCEDURE ( NUMB ) ; 

DECLARE NUMB ADDRESS; 

value(mp)=numb; 

END sstavalue; 

SST$VALUE2: PROCEDURE (ADDR ) J 
DECLARE ADDR ADDRESS,* 

value2(mp)=addr; 

END SETA VALUE2 J 
SU3ACNT: PROCEDURE 3YTEJ 

IF (SUBAIND : =SU3AlND + 1)>6 THEN 
SU3AlND=l ; 

RETURN 5UB$IND; 

END subacnt; 

C0DE$3YTS : PROCEDURE (CODE); 

DECLARE CODE BYTE*, 

CALL BYTEAOUT! CODE) ; 

CALL INC$C0UNT(1); 

END CODE A3YTE ; 

CODE$ ADDRESS : PROCEDURE (CODE); 

DECLARE CODE ADDRESS; 

CALL addrAout(code) ; 

CALL I NCACOUNT ( 2 ) ; 

end codeAaddress; 

INPUTANUMERIC : PROCEDURE 3YTE*, 

DO CTR=1 TO VARC(0); 

IF NOT DIGIT(VARC( CTR) ) THEN RETURN FALSE; 

end; 
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RETURN TRUE? 

END INPUTSNUMERICJ 

CONVERTS INTEGER: PROCEDURE ADDRESS; 

A CTR=0; 

DO CTR=1 TO VARC(0); 

IE NOT DIGIT(VARC(CTR) ) THEN CALL PR I NTS ERROR ( 'NN ' ) 
A$CTR=SHL ( ACTR , 3 )+SHL ( ACTR , 1 ) + VARC(CTR) - '0'; 

end; 

RETURN ACTRJ 

end convertSinteger; 

BACKSTUFF: PROCEDURE (ADD1.ADD2); 

DECLARE ( ADD 1 , ADD2 ) ADDRESS J 

CALL byteSout(bst) ; 

CALL ADDRSOUT ( ADD1 ) ; 

CALL ADDRSCUT(ADD2 ) 5 
END 3ACKSSTUFF; 

UNRESOLV ED $ BRANCH : PROCEDURE; 

CALL SETS VALUE ( N EXT $ AVAILABLE +1); 

CALL 0NESaDDR$0PP(3RN ,0) J 
CALL SET$VALUE2(NEXT$ AVAILABLE) ; 

END UNRESOLVED$3RANCH5 
BACKSCOND: PROCEDURE; 

CALL BACKSTUFF ( VALUE ( SP-1 ) , NEXT$AVA I LABLE) ; 

end backscond; 

SETSBRANCH: PROCEDURE; 

CALL SET$ VALUE ( N EX T$AVAI LABLE) ; 

CALL C ODE $ ADDRESS ( 0 ) ; 

END setSbranch; 

KEEPS V ALUES : PROCEDURE; 

CALL SETSVALUE( VALUE ( S? ) ) ; 

CALL S ETS V ALUE2 ( VALUE2( S P ) ) J 
END KSEPSVALUSS; 

GETSRECSADDRESS : ?ROCEDURE( RECORDS ADDR ) ADDRESS; 

DECLARE (RECOHDSADDR, HOLDS ADDR) ADDRESS J 

cur$sym=recordSaddr; 
holdSaddr=getSaddress ; 
curSsyp=getS?cbSaddr; 

RETURN HOLDSADDR; 

end c-stSrecsaddress; 

GETSRECSLEN : ?ROCEDURE( RECORDSaDDH ) ADDRESS; 

DECLARE (RECCRDSADDR, HOLDSLSNGTH ) ADDRESS ; 

curSsym=recordsaddr; 

holdslength=getslsngth; 

CURS SYM=GET$FCBS ADDR; 

RETURN ECLDSLENGTH; 

end getSrecSlen; 

STDSATTRIBUTES : PROCEDURE ( TYPE ) ; 

DECLARE TYPE BYTE; 

CALL CODES ADDRESS (GETSFC3S ADDR ) ? 

CALL CODES ADDRESS ( GE TSR ECS ADDR ES S ( GETS ADDRESS ) ) ; 

CALL CODES ADDRESS ( GETSRECSLEN (GETS ADDRESS) ); 

IF TYPE=0 THEN RETURN; 

CUR$S YM=S YMBOL$ ADDR ( REL$ ID ) J 
CALL CODESADDflESS (GETSADDRESS ) ; 
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CALL CODESBYTE(GETSLENGTH) ; 

END STDS ATTRIBUTES ; 

WRITESASR3C0RD: PROCEDURE? 

IE GETSLE VELOl THEN CALL ?RlNT$ERROR( 'WL' ) ? 

ELSE do; 

curSsym=getSfcb$addr; 

IF ( CTP : =GETSTYPE )=1 THEN 

do; 

CALL CODESBYTE (WTF) ; 

CALL STDSATTRIBUTES (0); 

end; 

ELSE IF CTR=2 THEN 

do; 

CALL CODESBYTE ( VRS ) J 
CALL S'TD$ATTR IBUTES ( 1 ) J 

end; 

ELSE IF CTR=3 THEN 

do; 

CALL CODESBYTE(VRR) J 
CALL STDSATTRIBUTES (l ) ; 

end; 

ELSE IF CTR=4 THEN 

do; 

CALL C0DESBYTE(W7L) J 
CALL STDSATTRIBUTES ( 0 ) J 

end; 

ELSE CALL PR I NT $ ERR OR ( 'FT ' ) J 

end; 

END writsSaSrecord; 

RSADSASFILE: PROCEDURE; 

IF ( CTR:=GETSTYPE )=1 THEN 

do; 

call ccdsSbyte(rdf) ; 

CALL STDSATTRIBUTES ( 0) ; 

end; 

ELSE IF CTR=2 THEN 

do; 

CALL CODESBYTE(RRS) ; 

CALL STDSATTRIBUTES (1 ) ; 

end; 

ELSE IF CTR=3 THEN 

do; 

CALL CODESBTTE(RRR) J 
CALL STDSATTRIBUTES (1) ; 

end; 

ELSE IF CTR=4 THEN 

do; 

CALL C0DS$3YTE(RVL) 5 
CALL STDSATTRIBUTES (0) J 

end; 

ELSE CALL PR INTSERROR ( 'FT ' ) J 

END readSasfile; 

ARITH^ETICSTYPE : PROCEDURE BYTE; 

IF ( ( LSTY PE :=ANDSOUT$ OCCURS ( LSTYPE ) )>=NUMER ICS LITERAL) 
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AND ( LiTYPE< = COP!P) THEN RETURN L$TY?E - NUMEE I CiLI TERAL 

CALL invalid$type; 

RETURN 0; 

end arithmetic$ty?e; 

DELETE$A$FILE: PROCEDURE; 

IE ( CTR :=GET$TYPE )=3 THEN 

do; 

CALL CODE$BYTE(DLR) ; 

CALL ST D$ ATTRIBUTES ( 1 ) ; 

end; 

ELSE IF CTR=2 THEN 

do; 

CALL CODE$BYTE( DLS ) ; 

CALL STD$ ATTRI BUTES (0 ) ; 

end; 

ELSE CALL PR INT^ERROR ( ' IT ' ) ; 

END delste$a$file; 

RE WRITE$A$ RECORD: PROCEDURE; 

IF GET^LEVELOl THEN CALL PRINT$3RR0R ( 'WL ' ) J 
ELSE do; 

cur$sym=get$fcb$addr; 

IF ( CTR:=GET$TY?E)=3 THEN 

do; 

CALL CODEiBYTE (RWR ) ; 

CALL STD $ ATTR I3UTES ( 1 ) ; 

end; 

ELSE IF CTR=2 THEN 

do; 

CALL CODE$BYTE(RWS) ; 

CALL STDS ATTRIBUTES (0 ) J 

end; 

ELSE CALL PRINT$3RR0R( 'IT') ; 

end; 

END REWRITE^ A$RECORD J 
ATTRIBUTES: PROCEDURE; 

CALL CODE$ ADDRESS ( L$ADDR ) ; 

CALL C0DE$3YTE ( LSLENGTH ) J 
CALL CODE^BYTE ( L$DEC ) J 
END ATTRIBUTES? 

LO AD$L$ID : PROCEDURE(S$PTR) ; 

DECLARE S $PTR BYTE; 

IF ( ( A$CTR := VALUE ( S $PTR ) ) <= NON^NUMERICSLIT) OR 
( ACTR = NUMERIC$LITERAL) THEN 

do; 

L$ADDR=VALUE2(S?TR); 

L£LENGTE=C0N£LSNGTH; 

l$type=asctr; 

return; 

end; 

if a$ctr<=lit$zero then 
do; 

l$type,l$addr=a$ctr; 

L$LENGTH=i; 

return; 
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end; 

cur$sym=value(s$ptr); 

lstype=get$type; 

L$LENGTH=GETS LENGTH? 

l^dec=get^deci^al; 

I F( L$ADDR : =V ALUE2( S S?TR ) ) =0 THEN L$ ADDR=GET$ ADDRESS ; 

END load$l$id; 

LOAD$REG: PROCEDURE ( REG$NO,PTR) ; 

DECLARE ( REG$NO , PTR ) BYTE; 

CALL LOAD$L$ ID ( PTR ) ; 

CALL CODE$BYTE ( LOD+AR ITHMETI CSTYPE ) ? 

CALL ATTRIBUTES; 

CALL CODES BYTE ( REG$NO ) ; 

END loadSreg; 

STORE$REG: PROCEDURE ( PTR ) ; 4 

DECLARE PTR eyte; 

CALL LOAD$L$ID(PTR) ; 

CALL code$byte(sto + ARITHMETI C^TYPS -1); 

CALL attributes; 
end storeSreg; 

STORESCONSTANT : PROCEDURE ADDRESS; 

IF(MAXSlNT$MEM:=MAXSlNTSMEM - VARC(0) )<NSXT$AVAILA3LE 
THEN CALL EATAL$ERROR( 'MO ' ) J 
CALL BYTESOUT ( I NT ) J 
CALL ADDR$OUT(MAX$INT$MEM); 

CALL ADDRSOUT ( CO N$ LENGTH : =7ARC ( 0 ) ); 

DC CTR = 1 TC conslength; 

CALL BYTESOUT (VARC (CTR ) ) J 

end; 

RETURN ^AXSINTSMEM; 

end storeSconstant; 

NUMERI C$LIT : PROCEDURE BYTE; 

DECLARE CHAR BYTE; 

DO CTR=1 TO VARC(0)J 

IE NOT ( D IGI T( CHAR :=7ARC ( CTR ) ) 

OR ( CHAR= ' ) OR ( CHAR = ' + ' ) 

OR (CHAR*'.')) THEN RETURN FALSE J 

end; 

RETURN TRUE; 

end nu^ericSlit; 

ALPHASLIT: PROCEDURE BYTE; 

DO CTR=1 TO VARC(0)J 

I? NOT ( LETTER (V ARC (CTR ) ) ) THEN RETURN FALSE; 

end; 

RETURN TRUE; 

END ALPHASLIT; 

ROUNDSSTORE : PROCEDURE; 

IF V ALUE ( S P ) <>0 THEN 

do; 

CALL CODESBYTE(RND); 

CALL COOE$BYTE(L$DEC); 

end; 

CALL STOREiREG(SP-l); 

end roundSstore; 
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ADDiSUB : PROCEDURE (INDEX); 

DECLARE INDEX BYTE; 

CALL LOAD$REG(0,MPP1) ; 

IF V ALUE ( SP-3 ) <>0 THEN 

do; 

CALL LOADiREG ( 1 t SP-3 ) J 
CALL CODE>BYTE( ADD ) ; 

CALL CODE$BYTE(STI )J 

end; 

CALL LOADiREG (1 , SP-1 ) ; 

CALL CODEiBYTE ( ADD + INDEX); 

CALL ROUNDiSTORS; 

END ADDiSUB; 

MULTiDIV: PROCEDURE ( I NDEX ) ; 

DECLARE INDEX BYTE; 

CALL LOAD$REG( 0 ,MPP1 ) ; 

CALL LOADiREG ( 1 ,SP-1 ) ; 

CALL C ODEiBYTE ( MUL + INDEX); 

CALL ROUNDiSTORE; 

END MULTiDIV; 

CHECKiSUBSCRIPT: PROCEDURE; 

CURi SY M=V ALU E ( MP ) ; 

IF GET iTYPE<MULTiOCCURS THEN 

do; 

CALL PRINTi ERROR ( 'IS ' ) ; 

return; 

end; 

IF I NPUTi NUMERI C THEN 

do; 

CALL SETi VALUE2 ( GETi ADDRESS + ( GETi LENGTH * 
CONVERTilNTEGER) ) ; 

return; 

end; 

cur$sym=match; 

IF ( (CTR:=GETiTY?E XNUMERIC ) OR (CTR>COM?) THEN 
CALL PRI NTi ERROR ( 'TE') ; 

CALL ONS$ADDRiOPP(SCR ,GETiADDRESS ) ; 

CALL CODSiBYTE(SUBiCNT) ; 

CALL CODEiBYTE(GETiLENGTH); 

CALL SET$VALUE2(SUBiIND) ; 

END CHECKiSUBSCRIPT; 

LOADiLABEL: PROCEDURE; 

CURiSYM=VALUE(MP); 

IF ( AiCTR :=GETiADDRESS ) <>0 THEN 

CALL BACK iS TUFF ( AiCTR, VALUE 2 (M?) ) J 
CALL SET$ ADDRESS ( VALUE2(MP) ) ; 

CALL SETiTYPE(LABELiTYPE) J 

IF ( AiCTR:=GETi?CBiADDR)<>0 THEN 

CALL 3ACK$STUFF( AiCTR , NEXTi AVAI LABLE ) J 
SYMBOLiADDR(FCBiADDR)=NSXTi AVAILABLE? 

CALL ONEiADDRiOP? ( RET ,0) J 
END LOADiLABEL; 

LOADiSECiLABEL : PROCEDURE; 

A$CTR= VALUE ( MP ) J 
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CALL SET$VALUE(EOLD$SECTION ) 5 

hold$section=a$ctr; 

A$CTR=VALUE2(MP) J 

CALL SET$YALUE2(H0LD$SEC$ADDR) J 

HOLD$S EC$ ADDR = A$ CTR ; 

CALL L0AD$LA3ELJ 
END LOAD$SEC$LABELi 

LABEL$ADDR$ OFFSET : PROCEDURE ( ADDR , HOLD, OFFSET) ADDRESS; 
DECLARE ADDR ADDRESS J 
DECLARE (HOLD, OFFSET, CTR) BYTE; 

CUR$SYM*ADDR ; 

I F( CTR :=GET$ TYPE )=LAB EL £ TYPE THEN 

do; 

IF HOLD THEN RETURN GST$ ADDRESS J 
RETURN GET$FC3$ADDR; 

end; 

IF CTROUNRESOLVED THEN CALL I NVALID$TY?E; 

IF HOLD THEN 

do; 

A$CTR=GET $ ADDRESS ; 

CALL SET$ ADDRESS ( N EX T$ AVAILABLE + OFFSET); 

RETURN A$CTRJ 

end; 

a$ctr=get$fcb$addr; 

SYMBOL £ ADDR ( FCBiADDR) =NEXT$ AVAILABLE + OFFSET; 

RETURN A$CTR; 

END LABELiADDR$CFFSST; 

LABEL$ADDR: PROCEDURE (ADDR, HOLD) ADDRESS; 

DECLARE ADDR ADDRESS, 

HOLD byte; 

RETURN LABEL ^ADDRi OFF SET (ADDR, HOLD, 1); 

END label$addr; 

CODE$FOR$DISPLAY: PROCEDURE (PCINT); 

DECLARE POINT BYTE; 

CALL LOAD$Li ID( POINT ) ; 

CALL CNS£ADDR$0PP(DIS ,L$ADDR) J 
CALL CODE £ BYTE ( LiLENGTH ) 5 
I? DISPLAY$FLAG THEN CALL CODE^BTTE (1)5 
ELSE CALL CODE$3YTE(0 ) J 

display$flag=false; 
end code$for$display; 

A$AN$TYPE: PROCEDURE BYTE? 

RETURN ( L$TYPE=ALPHA) OR ( L$TYPE=ALPHA$NUM ) i 

END a$an$type; 

NOTilNTEGER: PROCEDURE BYTE; 

RETURN L$DECO0J 
END NOTSINTEGER; 

NUMER I C£ TYPE : PROCEDURE BYTE; 

RETURN (LiTYPE>=NUMERIC$LITERAL) AND ( L$TY?E<=COM? ) J 
END numeric$ty?e; 

GEN$COMPARE: PROCEDURE; 

DECLARE ( H$TYPE,H$DEC ) BYTE, 

(H$ ADDR ,H$ LENGTH ) ADDRESS; 

CALL LCADiL$ID(M?) ; 
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L$TYP5*AND$0UT$0CCURS (L$TY?E) ? 

I? C0NDSTYPE=3 THEN /* COMPARE FOB NUMERIC */ 

do; 

IF ASAN$TYPE OR (LSTYPE>COMP) THEN CALL INVALIDSTYPS 
CALL SET$VALUF2( NEXT $ AVAILABLE); 

IF LSTYPE=NUMERIC THEN CALL CODESBYTE ( CNU ) ? 

ELSE CALL CODE$BYTE( CNS ) ; 

CALL CODE $ ADDRESS ( L$ ADDR ) ? 

CALL CODESADDRESS ( L$LENGTH) J 

call setsbranch; 
end; 

ELSE IF COND $TYPE=4 THEN 

do; 

IF NUMER I CSTYPE THEN CALL I NVALID$TY?E; 

CALL SET$VALUE2(NEXT$AVAILA3LE) ; 

CALL C0DE$3YTS(CAL); 

CALL CODE $ ADDRESS ( L$ ADDR ) ? 

CALL CODES ADDRESS ( L$ LENGTH) J 
CALL SETS BRANCH; 

end; 

else DO ) 

IF NUMERICSTYPE then ctr=i; 

ELSE CTR=e; 

hSty?e=l$type; 

hSdec=l$dec; 

hSaddr=l$addr; 

h$length=l$length; 

CALL LOADSLSID(SP) 5 
IF NUMERICSTYPE then ctr=ctr+i; 

IF CTR=2 THEN /* NUMERIC COMPARE */ 

do; 

CALL LOAD$REG(0,MP) 5 

CALL SET$VALUE2(NEXTSA?AlLABLE-6) ; 

CALL LOADSREG ( 1 , SP ) ? 

CALL C0DE$3YTE(SU3); 

CALL CODE$BYTE(RGT + CONDSTYPE); 

CALL SSTS3RANCH; 

end; 

ELS E DO * 

/* ALPHA NUMERIC COMPARE */ 

IF (HSDECO0) OR (HSTY?S=COMP) 

OR (ISDECO0) OR { L$TYPE=COMP ) 

OR (HSLENGTHOLSLENGTH) THEN CALL INVALIDSTYPE; 
CALL S ETS V ALU E2 ( NEXT $ AVAILABLE ) J 
CALL CODESBYTE ( SGT+CONDSTYPE ) ; 

CALL CODESADDRESS(HSADDR) ; 

CALL CODE$ADDRESS(LSADDR) ; 

CALL CODESADDRESS(HSLENGTH) ; 

CALL SETS3RANCH; 
end; 

END? 

end genScompare; 

M07E$TYPE: PROCEDURE BYTE? 

DECLARE 
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HOLD$TYPE BYTE, 

ALPHA $ NUM$ MOVE LIT '0', 

AiN $ED$MOVE LIT 'l', 

NUMERI C^MOVE LIT '2', 

N$ED$MOVE LIT '3'? 

L$TYPE=AND$OUT$OCCURS(L$TYPE)? 

IF( ( HO LD$TYP E :=A.ND$OUT$ OCCURS ( GET$TYPE ) ) =GROUP ) OR 
( L$TYPE=GR CUP ) 

THEN RETURN ALPHA$ NUM$MOVE? 

IF HOLD$TYPE=ALPHA THEN 

IF A$AN$TY?E OR ( L$TYPE=A$ED) OR ( L£TY?E=A£N$ED ) 

OR ( (ALPEAiLIT$FLAG) AND ( L$TYPE = NO NiNUMERI C £L IT ) ) 
THEN RETURN ALPHA$ NUM^MOVS? 

I? HOLD$TYPE=ALPHA$ NUM THEN 
DO t 

IF NOT$ INTEGER THEN CALL INVALID$TYPE ? 

RETURN AL?RA$NUM$M0VE; 

END? 

IF (HOLD$TYPE>=NUMERIC) AND ( HOLD<TYPE<=COMP ) THEN 
DO? 

IF ( L^ TYPE=ALPH A ) OR ( L$TYPE>COM? ) THEN 
CALL I NVALID$TYPE? 

RETURN NUMERIC^MCVE? 

END? 

IF HOLDiTYPE=A^NiSD THEN 
DO? 

IF NOT$ I NTEGER THEN CALL INVALID^TYPE ? 

RETURN A*N$ED$MOVE? 

end; 

IF H0LD£TYPE=A$3D THEN 

IF A$ AN^T YPE OR (L$TY?E>COMP ) OR (L$TY?S 
= NON$ NUMERICAL IT ) 

THEN RETURN A.$N £ED$M07S? 

IF HOLD$TYPS=NUM$SD THEN 

IF NUMERI C$TY?E OR ( L$ TYPE=ALPEAi NUM ) THEN 
RETURN N^EDiMOVE? 

CALL invalid$ty?e; 

RETURN 05 
END move^type; 

GEN$MOVE -.procedure; 

DECLARE 

LENGTH1 ADDRESS, 

ADDR1 ADDRESS, 

EXTRA ADDRESS? 

ADD$ADD^LEN : PROCEDURE? 

CALL C ODE £ ADDRESS ( ADDR1 ) ? 

CALL CODE$ADDRESS ( L$ ADDR ) ? 

CALL C ODE $ ADDRESS ( L$ LENGTH ) ? 

END ADD$ADD£ LEN ? 

CODE$FOR$EDI T : PROCEDURE? 

CALL ADD$ ADD^LSN ? 

CALL C ODE $ A DDR ESS (GETSFCBSADDR)? 

CALL CODE^ADDRESS ( LENGTH1 ) ? 

END CODEiFOR$EDIT? 
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CALL L0AD$L$ID(MPP1); 

CUR$SYM=VALUE(SP) ; 

IF ( ADDR1 :=VALUE2 ( SP ) ) = 0 THEN ADDR1=GET$ ADDRESS ; 

lengthi=get$length; 

DO CASS move$type; 

/* ALPHA NUMERIC MOVE */ 

do; 

IF LENGTH1>L$ LENGTH THEN EXTRA =LENGTH1-L$ LENGTH 
ELSE do; 

FXTRA=0 ; 

L$LENGTH=LENGTHi; 

end; 

CALL CODE$BYTE(MOV ); 

CALL ADD$ ADDiLEN ; 

CALL CODE^ADDRESS ( EXTRA ) ; 

end; 

/* ALPHA NUMERIC EDITED */ 

do; 

CALL CODE$BYTE( MED ) J 
CALL code$for$edit; 
end; 

/* NUMERIC MOVE */ 

do; 

CALL L0AD$REG(2,MPP1 ) ; 

CALL STORE$REG(SP) J 

end; 

/* NUMERIC EDITED MOVE */ 



do; 

CALL CODS$BYTE(MNE) ; 

call ccde£for$edit; 

CALL CODE^BYTE(L^DEC) J 
CALL CODEiBYTE (GET$DECIMAL) ; 

end; 

end; 

END GEN$M07E; 

CODE^GEN : PROCSDURE(PRODUCTION ) ; 

DECLARE PRODUCTION BYTE; 

IF ?RI NTiPROD THEN 

do; 

CALL crlf; 

CALL PRI NTCEAR( POUND ) ; 

CALL PRI NT$ NUMBER ( PRODUCTION ) 

end; 

DO CASE production; 

/* PRODUCTIONS*/ 

/* CASE 0 NOT USED */ 

/* 1 <?-DIV> ::= PROCEDURE DIVISION <USING> . 

<PROC-BODY> */ 

do; 

COMPILING = false; 
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IF SECTIONiFLAG THEN CALL LOADSSEC SLA3EL J 

end; 

/* 2 <USING> ::= USING <ID-STRING> */ 

cm notSimplimented; /* inter prcg comm */ 

/* 3 \ ! <EMPTT> */ 

J /* NO ACTION REQUIRED */ 

/* 4 <ID-STRING> ::= <ID> */ 

ID$STACK ( ID$PTR : =0 )=VALUE( SP ) ; 

/* 5 \ ! <ID-STRING> <ID> */ 

do; 

IF( ID$PTR :=IDPTR+1 ) =20 THEN 

do; 

call pr i nt Terror ( 'id' ) ; 

ID^PTR=l 9; 

end; 

ID$STACK( ID$PTR)=VALUE(SP); 

end; 

/* 6 <PR0C-3CDT> ::= <PARAGRAPH> */ 

J /* NO ACTION REQUIRED */ 

/* ? \! <PROC-BODT> <PARAGRAPH> */ 

; /* NO ACTION REQUIRED */ 

/* 8 <PARAGRAPH> : := <ID> . <SENTENCE-LIST> V 

do; 

IF SECTIONSFLAG=0 THEN SECTI 0N$FLAG=2 J 
CALL LOAD$LABELJ 
end; 

/* 9 \! <ID> SECTION . */ 

do; 

IF SECTI0N$FLAG<>1 THEN 

do; 

I? SECT I CNSFLAG=2 THEN CALL PRI NT$ERROR ( 'P7 ' ) ; 
SECTION$FLAG=l ; 

HOLDS SSCTION=VALUE(MP); 

H0LD$SEC$ADDR*7ALUE2( MP ) ; 
end; 

ELSE CALL LOAD$SEC$ LABEL ; 

end; 

/* 10 <S ENTENCE-LI ST> : := <SENTENCE> . */ 

; /* NO ACTION REQUIRED */ 

/* 11 \ ! <S ENTENCE-LI ST > <SENTENCS> . */ 

; /* NO ACTION REQUIRED */ 

/* 12 <SENTENCE> s := <IMPERATI7E> V 

J /* NO ACTION REQUIRED */ 

/* 13 \! <CONDITIONAL> */ 

J /* NO ACTION REQUIRED *7 
/* 14 \! ENTER <ID> <OPT-ID> */ 

CALL N0T$IMPLIMENTED; /* LANGUAGE CHANGE */ 

/* 15 <IMPSRATIVE> : := ACCEPT <SU3ID> */ 

do; 

CALL LOAD$ L$ID(SP); 

CALL ONES ADDRSOPP ( AC C , LSADDR) J 

CALL codeSbyte(lSlength) ; 
end; 

/* 16 \ ! <ARITHMETIC> */ 



218 



; /* NO ACTION REQUIRED */ 

/* 17 \ ! CALL <LIT> <USING> */ 

CALL NOT$IMPLlMENTED; /* INTER PROG COMM */ 

/* 18 \! CLOSE <ID> */ 

DO i 

DECLARE TYPE BYTE; 

TYPE=GETiTY?E » 

IF ( TYPE>0 ) AND (TYPE<5) THEN 

CALL ONE$ADDR$OPP(CLS,GET$FCB$ADDR); 

ELSE CALL PRINT$ERR0R( 'CE' ) > 

end; 

/* 19 \! <FILE-ACT> */ 

J /* NO ACTION REQUIRED */ 

/* 20 \! DISPLAY < LI T/I D> <OPT-LIT/ID> */ 

do; 

CALL C0DE5F0R$DISPLAY(MP?1) ; 

IF VALUE(SP)<>0 THEN 

do; 

dis?lay$flag=true; 

CALL CODE^FO REDISPLAY (SP) ; 

end; 

end; 

/* 21 \ ! EXIT <?R0GRAM-ID> */ 

; /* NO ACTION REQUIRED */ 

/* 22 \t GO < ID> */ 

CALL ONE5ADDR$OPP ( BRN , LABEL $ ADD?. ( VALUE ( SP ) , 1 ) ) J 
/* 23 \ ! GO < ID-STRI NG> DEPENDING <ID> */ 

do; 

CALL CODE$BYTE(GDP) ; 

CALL CODE$BYTE(ID$PT?.); 

CUR5SYM=VALUS(SP) ; 

CALL CO DE £ 3YTE (GET $ LENGTH ) J 
CALL CODS$ADDRESS ( GET $ ADDRESS ) ; 

DO CTR=0 TO id5ptr; 

CALL 

CODE$ ADDRESS (LABELS ADDR$OFFSET( IDiSTACKf ID5PTR) , 1,0)); 

end; 

end; 

/* 24 \! M07E <LIT/ID> TO <SU3ID> */ 

CALL gen$move; 

/* 25 \! OPEN <TY?E-ACTION> <ID> */ 

do; 

DECLARE TYPE BYTE; 

TYPE=GET5TYPEJ 

IF ( TY?E=1 OR TY?E=4) AND ( VALUE( MPP1 ) 02 ) 

THEN CALL ONE$ADDR$OPP ( OPN+V ALUE ( MPP1 ) ,GET$?C3$ ADDR ) J 
ELSE 

IF ( TY?E=2 OR TYPE=3 ) THEN 

CALL 0NE$ADDR$0?P(0PN+VALU3(MPP1 ) ,GET5?CB5ADER) J 
ELSE CALL PRINTiEHP.OR ( 'OE' ) ; 

end; 

/* 26 \! PERFORM <ID> <T5RU> <FINISH> */ 

do; 

DECLARE ( ADDP.2 , ADDR3) ADDRESS; 
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IF VALUE ( SP-1 )=0 

THEN ADDR2=L ABEL *AD DR* OFFSET (VALUE ( MPP1 ) ,0,3); 

ELSE ADDR2=LABEL*ADDR*0FFSET(7ALUE(SP-1) ,0,3) ; 

IF ( ADDR3:=VALUE2(SP) )=0 THEN ADDR3=NEXT*AVAI LAELE 
+ ?; 

ELSE CALL BACKSTUFF (V ALUE( SP ) , N EXT $ AV A ILA3LE + 7); 

CALL ONES ADDRSOPP( PER, LABEL* ADDR( VALUE(MPPl) ,1 ) ) ; 

CALL C ODE $ ADDRESS ( ADDR2 ) ; 

CALL CODE* ADDRESS (ADDR3) ,* 

end; 

/* 27 \ ! <READ- ID> */ 

CALL NOT* I MPL IMENTED J /* GRAMMAR ERROR */ 

/* 28 \! STOP <TSRMINATS> */ 

do; 

IF V ALUE ( S P ) =0 THEN CALL CODESBYTE ( STP ) ; 

ELSE do; 

CALLCNSSADDRSOPP (STD , VALUE2( SP ) ) J 
C ALLCODS* BYTE ( CON* LENGTH ) J 

end; 

end; 

/* 29 <C0NDITI0NAL> ::= <ARITHMETIC> <SIZE-ERROR> */ 

/* 29 <1 MPERATI 7E> */ 

CALL back*cond; 

/* 30 \ ! <FILE-ACT> <INVALID> <IMPERATIVE> */ 

CALL back*cond; 

/* 31 \t <IF-NONTERMINAL> <condition> 

<ACTION> ELSE */ 

/* 31 <IMPERATI VS> */ 

do; 

CALL BACKS TUFF(VALUE(MPP1) ,7ALUE2(S?-2 ) ) ; 

CALL BACK S TUFF ( VALUE ( SP-2) , NEXT* AVAILABLE) ; 

end; 

/* 32 \ ! <READ-ID> <SPECIAL> <IMPERATIVE> */ 

CALL back*cond; 

/* 33 <ARITHMETIC> : := ADD <L/ID> <OPT-L/ID> TO 

<SUB ID> */ 

/* 33 <ROUND> */ 

CALL ADD*SUB(0)5 

/* 34 \ ! DIVIDE <L/ID> INTO <SU3ID> <RCUND> */ 

CALL MULT*DIV (1 ) J 

/* 35 \! MULTIPLY <L/ID> BY <SUBID> <ROUND> *./ 

CALL MULT *DI 7(0 ) * 

/* 36 \! SUBTRACT <L/ID> <0PT-L/ID> FROM */ 

/* 36 <SUBID> <RCUND> */ 

CALL addSsub ( 1 ) ; 

/* 37 <FILE-ACT> s := DELETE <ID> */ 

call dslstsSaSfile; 

/* 38 \! REWRITE <ID> */ 

CALL REWRITS$A*RECORD; 

/* 39 \ ! WRITE <ID> <SPEC I AL~ACT> */ 

CALL write*a*record; 

/* 40 <CONDITION> ::= <LIT/ID> <NOT> <COND-TYPE> */ 

do; 

IF IFSFLAG then 
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/* RESET IF$FLAG */ 



do; 

IF$FLAG=NOT IF$FLAG; 
CALL C0DE$3YTE( MEG) > 

end; 

CALL GEN^COMPARE; 



end; 

/* 41 <COND-TYPE> ::= NUMERIC */ 

C0ND$TY?E=3; 

/* 42 \ ! ALPHABETIC */ 

C0ND$TYPE=4; 

/* 43 \ ! <COMPARE> <LIT/ID) */ 

CALL KEEP^ VALUES J 

/* 44 <NOT> ::= NOT */ 

IE NOT IF^FLAG THEN 
CALL CODE$BYTE(NEG) ; 

ELSE IF$FLAG=NOT IF^FLAGJ /* RESET IF$FLAG */ 

/* 45 \ ! <EMPTY> */ 



J /* NO ACTION REQUIRED */ 

/* 46 <C0MPAR5> : := GREATER 

COND$TY PE=0 ; 

/* 47 \ ! LESS */ 

COND$TYPE=l J 

/* 48 \ ! EQUAL */ 

C0ND$TYPE=2; 

/* 49 <ROUND> ::= ROUNDED 

CALL SET$VALUE(1) ; 

/* 50 \! <EMPTY > */ 

J /* NO ACTION REQUIRED */ 

/* 51 <TERM I NATE> ::= <LITERAL> 

; /* NO ACTION REQUIRED */ 

/* 52 \ ! RUN */ 

J /* NO ACTION REQUIRED - VALUE(SP) ALREADY 
/* 53 <SPECIAL> ::= <INVALID> 

J /* NO ACTION REQUIRED */ 

/* 54 \! END */ 



*/ 



*/ 



*/ 



ZERO */ 



do; 

CALL SET$VALUE(2) ; 

CALL CODE$BYTE( EOR) ; 

CALL SET$BRANCH5 

end; 

/* 55 <OPT-ID> ::= <SUBID> 

; /* VALUE AND VALUE2 ALREADY SET */ 

/* 56 \ ! */ 

5 /* VALUE ALREADY ZERO */ 

/* 57 <ACT I CN > ::= <IM?ERATIVE> 

CALL UNRESOLVSD^BRANCH; 

/* 58 \ ! NEXT SENTENCE 

CALL unrssclved$branch; 

/* 59 <THRU > ::= THRU <ID> 

CALL KEEPS VALUES ; 

/* 60 \! */ 

J /* NO ACTION REQUIRED */ 

/* 61 <FINISH> ::= <L/ID) TIMES 

do; 



*/ 



*/ 



*7 



V 



*/ 
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CALL LOAD$ L$ ID ( MP ) » 

CALL ONE$ADDP.$OPP(LDI .LiADDR) J 
CALL CODE$BYTE(L$LENGTH); 

CALL SET$VALUE2(NEXT$AVAILABLE) ; 

CALL ONE$ A DDR$OPP ( DEC , 0 ) J 
CALL SET$VALUE(NEXT$AVAILABLS) 5 
CALLCODE$ADDRESS(0) J END; 

/* 62 \! UNTIL <CONDITION> #/ 

CALL KEEP$VALUES; 

/* 63 \ ! */ 

J /* NO ACTION REQUIRED */ 

/* 64 <INVALID> ::= INVALID */ 

do; 

CALL SET$VALUE(1); 

CALL CODE$BYTE( INV) ; 

CALL SETiBRANCHJ 



/* 65 <SI 2E-ERPOP.> : SIZE ERROR */ 

do; 

CALL C0DE$3YTE(SER) ; 

CALL unresolved$branch; 
end; 

/* 66 <SP2CI AL“ACT> ::= <WHEN> ADVANCING <HOW-MANY> 



CALL NOT$IMPLlMENTED; /* CAR RAGE 
/* 67 \ ! 

5 /* NO ACTION REQUIRED */ 

/* 68 <VHEN> : := BEFORE 

CALL NOTiIMPLiMSNTED; /* CARRAGE 
/* 69 \ ! AFTER 

CALL NOT$IMPLIMENTED; /* CARRAGE 
/* 70 <HOW-MANY> : := <INTEGER> 

CALL NOTilMPLIMENTEDf /* CARRAGE 
/* 71 \! PAGE 

CALL NOT$IMPLIMENTED; /* CARRAGE 
/* 72 <TYPE-.ACTION> ::= INPUT 



CONTROL */ 
*/ 



CONTROL */ 

CONTROL */ 

CONTROL */ 
*/ 

CONTROL */ 



; /* NO ACTION REQUIRED - VALUE(SP) ALREADY 

/* 73 \ ! OUTPUT */ 

CALL SET$VALUE(1); 

/* 74 \ ! 1-0 */ 

CALL SET$VALUE(2) J 
/* 75 <SU3 I D> ::= <SU3SCRIPT> 



*/ 






*/ 

ZERO V 



*/ 



; /* VALUE AND VALUE2 ALREADY SET */ 

/* 76 \ ! <ID> */ 

; /* NO ACTION REQUIRED */ 

/* 77 <1 NTEGER> : := <INPUT> */ 

CALL SET$V ALUE ( CONVERTSI N'TEGER ) J 
/* 78 < I D> = <INPUT> */ 



do; 

CALL SET$V ALUE (MATCH) J 
IF GET $TYPE=UN RESOLVED THEN 

CALL SET$VALUE2( NEXT $ AVAIL ABLE) J 

end; 

/* 79 <L/ID S > ::= <IN?UT> */ 



/ 
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IF NUMERI C $L IT THEN 

do; 

CALL SETS VALUE (NUMERICS LITERAL) 5 
CALL SET$VALUE2(ST0RESC0NSTANT) J 

end; 

ELSE CALL SETS VALUE (MATCH ) J 

end; 

/* 80 \! <SU3SCRIPT> */ 

J /* NO ACTION REOUI RED */ 

/* 81 \ ! ZERO */ 

CALL SETSV ALUE( LITS ZERO) ; 

/♦ 82 <SU3SCRIPT> ::= <ID> ( <INPUT> ) */ 

CALL CHSCKSSUBSCRIPT; 

/* 83 <OPT-L/ID> ::= <L/ID> */ 

J /* NO ACTION REQUIRED */ 

/* 84 \ ! <EMPTY> V 

J /* VALUE ALREADY SET */ 

/* 85 <NN-LIT> ::=<LIT> */ 

do; 

alphaSlitSflag = alphaslit; 

CALL SETS VALUE(NONS NUMERI CSLIT) ,* 

CALL S ET$ VALUE2(ST0 RESCON STANT) ; 

end; 



/* 86 \ ! SPACE 

CALL SETSVALUE(LITSSPACE) ; 

/* 87 \ ! QUOTE 

CALL SETSVALUE(LITSCUOTE); 

/* 88 <LITERAL> : := <NN-LIT> 

; /* NO ACTION REQUIRED */ 
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\ ! <INPUT> 



*/ 

*/ 

*/ 



/* 

y 

/* 

! 

/* 

• 

f 

/* 



*/ 



/* 
do; 

IF NOT NUMERICSLIT THEN CALL I NVALIDSTYPE; 
CALL SETS VALUE (NUMERICS LITERAL) J 
CALL SET$VALUE2( STORESC ON STANT ) ; 

end; 

/* 90 \ ! ZERO */ 

CALL SETSVALUEf L ITS ZERO) *’ 

/* 91 <LIT/ID> ::= <L/ID> 

/* NO ACTION REQUIRED */ 

92 \! <NN-LIT> */ 

/* NO ACTION REQUIRED */ 

93 <OPT-LIT/ID> : := <LIT/ID> 

/* NO ACTION REQUIRED */ 

94 \ I <EMPTY> */ 

/* NO ACTION REQUIRED */ 

95 <?ROGRAM-ID> : := <ID> 

CALL NOTSIMPLIMENTED; /* INTER PROG COMM */ 
/* 96 \ ! */ 

; /* NO ACTION REQUIRED */ 

/* 97 <READ-ID> : := READ <ID> 

CALL readsaSfile; 

/* 98 <IF-NONTERMINAL> ::= IF 

ifSflag = true; 

end; /* END OF CASE STATEMENT 



*/ 



# i 



/* 

*/ 



SET 



*/ 

IFSFLAG 



*/ 



*/ 
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emdcode$gen; 

GETIN1 -.PROCEDURE BYTE; 

RETURN INDEX1 (STATE); 

ENDGETINi; 

GETI N2 : PROCEDURE BYTE; 

RETURN INDEX2 (STATE ) » 

ENDGETI N2 J 

incsp-.procedure; 

VALUE(SP:=SP + 1)=0J /* CLEAR THE STACK WHILE 

INCREMENTING */ 

VALUE2 ( SP ) =0 * 

IF SP >= PSTACKSIZE TEEN CALL FATA L$ ERROR ( 'SO ' ) J 
ENDINCSP J 

LOOKAHEAD: PROCEDURE; 

IF NOLOOK THEN 

do; 

call scanner; 
nclook=false; 

IF PRINT$TOKEN then 
do; 

CALL C R LF 5 

CALL PRINTS NUMBER (TOKEN ) ; 

CALL PR I NTSCHAR ( ' ') 5 
CALL print$accum; 
end; 
end; 

endlookahead; 

NO $ CONFLICT: PROCEDURE (CSTATB) BYTE; 

DECLARE ( CSTATE , I , J ,K ) BYTE; 

j=indexi(cstate) ; 

5= J + INDEX2(CST»TE) - i; 

do i=j to k; 

IF READ1 ( I )=TOXEN THEN RETURN TRUE; 

end; 

returnfalse; 

endnosconflict; 

RECOVER: PROCEDURE BYTE; 

DECLARE TS? BYTE, ESTATE BYTE; 

DO forever; 
tsp=sp; 

DO WHILE TSP <> 255; 

IF NO$ CONFLICT (RS TATE : = STATES TACK (TSP) ) THEM 
DO? /* STATE WILL READ TOKEN */ 

IF SPOTSP THEN S? = TSP - 1 J 
RETURN ESTATE? 

end; 

TSP = TS? - i; 

end; 

CALL SCANNER; /* TRY ANOTHER TOKEN */ 

end; 

sndrscovsr; 

/* * * * * PROGRAM EXECUTION STARTS HERE * * */ 

/* INITIALIZATION */ 

T0KEN=63 5 /* PRIME THE SCANNER WITH -PROCEDURE- */ 



224 



CALLMCVE(PASS1$T0?-PASS1$LEN , . OUT?UT$FCB , P A S SliLEN ) 5 
/* THIS SETS 

OUTPUT FILE CONTROL BLOCK 

TOGGLES 

READ POINTER 

NEXT SYMBOL TABLE POINTER 

*/ 

OUTPUTS ND=(OUTPUT$PTR:=.OUTPUT$ BUFF-1) +1235 
C A LLPRINT$ ERROR (FALSE); /* INITIALIZE ERROR MSG OUTPUT */ 
# # if. # # # PARSER * * * * * & / 

DO WHILE COMPILING; 

IF STATE <= MAXRNO THEN /* READ STATE */ 

do; 

CALL I N C S P J 

STATESTACK(SP) = STATE; /* SAVE CURRENT STATS */ 

CALL lookahead; 

I=GETIN1 ; 

J = I + GETIN2 - l; 

DO 1=1 TO j; 

IF READl(I) = TOKEN THEN 

do; 

/* COPY THE ACCUMULATOR IF IT IS AN INPUT 
STRING. IF IT IS A RESERVED WORD IT DOES 
NOT NEED TO BE COPIED. */ 

IF ( TOKEN=I NPUTiSTR ) OR ( TOKEN=LITERAL ) THEN 
DO K=0 TO ACCUMO) ; 

VARC(K)=ACCUM(K) ; 

end; 

ST ATE=READ2 ( I ) ; 

nolcok=true; 

i=j; 

end; 

ELSE 

IF I=J THEN 

do; 

call ??int£error( ' n? ' ) ; 

CALL PR I NT ( . ERROR $ NEAR$ $ ) j 
CALL ?rint$accum; 

IF ( STATE :=P.ECOVER ) = 0 THEN COMPIL I NG=FALSE J 

end; 

end; 

end; /* END OF READ STATE */ 

ELSE 

IF ST AT S>MAXP NO THEN /* APPLY PRODUCTION STATE */ 

do; 

MP=S ? - GETIN2; 

MPP1 =MP + 1 ; 

CALL CODEiGEN (STATE - MAXPNO); 

sp=mp; 

I=GETIN1 J 

J=ST ATESTACK ( S? ) ; 

DO WHILE (K:=APPLY1 (I ) ) <> 0 AND JOKJ 
i=i + i; 

end; 
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IF ( K : =APPLY2 ( I ) ) =0 THEN COMPILI NG=FALSE J 

state=k; 

end; 

ELSE 

IF STATE<=MAXLNO THEN /-LOOKAHEAD STATE*/ 

do; 

I =GET I N 1 J 

CALL lookahead; 

DO WHILE ( K :=LOOKl ( I ) ) <>0 AND TOKEN OK; 

1=1+1 ; 
end; 

STATE=L00K2( I ) J 

end; 

ELSE 

do; /*push states*/ 

CALL INCSP; 

STATESTACK (SP)=GETIN2J 
STATS=GETIN1; 

end; 

end;/* of while compiling */ 

CALL3YTE$0UT ( TEH ) ; 

doweile output $ptr<>. output^ buff; 

CALL BYTE^OUT (TER) ; 

end; 

callclose; 

callcrlf; 

CALLPRINT( .END$0F$PART$2) J 

callboot; 

end; 
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INTER? : /* MODULE I N T E R P " */ 

do; 

/* COBOL INTERPRETER */ 

/* NORMALLY ORG 'ED TO X'100' */ 

/* GLOBAL DECLARATIONS AND LITERALS */ 



DECLARE 



LIT 


LITERALLY 


'LITERALLY', 




BDOS 


LIT 


'5H ' , /* 


ENTRY TO OPE? ATI 


BOOT 


LIT 


'0' , 


STSTEM */ 


CR 


LIT 


'13', 




LF 


LIT 


'10', 




TRUE 


LIT 


'l\ 




FALSE 


LIT 


'0 \ 




FOREVER 


LIT 


'WHILE TRUE' 


• 


/* 


UTILITY VARIABLES 


*/ 




DECLARE 


BOOTER 


ADDRESS 




INITIAL (00003) , 


INDEX 

A$CTP. 

CTR 

CTR1 

BASE 

B^BYTE 


BYTE, 
ADDRESS , 
BYTE, 

BYTE, 
ADDRESS , 
BASED BASE 


(1) 


BYTE, 


B5ADDR 


BASED BASE 


(1) 


ADDRESS, 


HOLD 

H^BYTE 


ADDRESS , 
BASED HOLD 


(1) 


BYTE, 


H$ADDR 


BASED HOLD 


(1) 


ADDRESS , 



/* CODE POINTERS */ 



CODE$START 
PROGRAM^ COUNTER 
CiBYTE 
C5ADDR 



LIT '3000H', 

A.DDRES S 

BASED PR OG R AM $ COUNTER (1) BYTE, 
BASED PROGRAM $ COUNTER (1) ADDRESS; 



/***** GLOBAL INPUT AND OUTPUT ROUTINES * - * * */ 



DECLARE 

CURRENT$FCB ADDRESS, 

START$OFFSST LIT '37'; 

MON 1 : PROCEDURE ( F , A ) EXTERNAL? 
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DECLARE F BYTE , A ADDRESS? 

END MONi; 

M0N2: PROCEDURE ( F, A ) BYTE EXTERNAL; 

DECLARE F BYTE, A ADDRESS; 

END M0N2J 

PRI NT$ CHAR : PROCEDURE (CHAR); 

DECLARE CHAR 3YTE; 

CALL MONI (2, CHAR); 

END print$char; 

CRLF: PROCEDURE? 

CALL PR I NT £ CHAR ( CR ) J 
CALL PRINT$CHAR(LF) ; 

END crlf; 

PRINT: PROCEDURE (A); 

DECLARE A ADDRESS; 

CALL crlf; 

CALL MONl(S, A); 

END print; 



READ: PROCEDURE ( A ) > 

DECLARE A ADDRESS; 
CALL MON1(10,A); 
END read; 



PRINTS ERROR : PROCEDURE (CODE); 
DECLARE CODE ADDRESS; 

CALL crlf; 

CALL PRINT$CHAR(HIGH( CODE) ) ; 
CALL PRINT$CHAR( LOW (CODE) ) J 
END PRINTSERROR; 



FATAL $ERROR : PROCEDURE( CODE ) ; 
DECLARE CODE ADDRESS; 

CALL PRlNT$ERROR(CODE) J 

CALL booter; 

END fatal$error; 



SHTSDMA : procedure; 

CALL MONI (26, CURR ENT$FC3 + START$OFFSET) ; 
END set$dma; 



OPEN: PROCEDURE ( ADDR ) 3YTEJ 
DECLARE ADDR ADDRESS J 

CALL SETSDMAJ /* INSURE DIRECTORY READ WON'T 

CL0B3ER CORE */ 
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RETURN M0N2 ( 15 , ADDR ) J 
END open; 



CLOSE: PROCEDURE (ADDR); 

DECLARE ADDR ADDRESS; 

IE M0N2(16,ADDR)=255 THEN CALL FA TAL$E?ROR ( 'CL ' ) ; 

END close; 



DELETE: PROCEDURE; 

CALL M0N1(19,CURRENT$FCB); 
END delete; 



MAKE: PROCEDURE (ADDR); 

DECLARE ADDR ADDRESS; 

IF MON 2 ( 22 , ADDR ) =255 THEN CALL FATAL$ ERROR ( 'ME ') ; 
END make; 



DI SK$READ : PROCEDURE 3YTE? 

RETURN MON 2 (20 , CURR SNT$?CB) ; 
END DISK$READ» 



DISK$WRITE : PROCEDURE BYTE; 

RETURN M0N2(21,CURRENT$FCB); 

end disk$write? 



/***** UTILITY PROCEDURES * * * * * * */ 



DECLARE 

SUBSCRIPT (8) ADDRESS; 



RES: PROCEDURE (ADDR) ADDRESS; 

/* THIS PROCEDURE RESOLVES THE ADDRESS OF A 
SUBSCRIPTED IDENTIFIER OR A LITERAL CONSTANT */ 

DECLARE ADDR ADDRESS? 

IF ADDR > 32 THEN RETURN ADDR? 

IF ADDR < 9 THEN RETURN SUBSCRIPT ( ADDR ) ; 

DO CASE ADDR - 9? 

RETURN .('0'); 

RETURN .(' ')? 

RETURN . ( ' ')? 

end; 

return e; 
end res; 
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MOVE: PROCEDURE (FROM, DESTINATION .COUNT ) ; 

DECLARE (FROM, DESTINATION .COUNT) ADDRESS, 

(F BASED FROM, D BASED DESTINATION) BYTE; 
DO WHILE ( COUNT :=COUNT - 1) <> 0FFFFE5 

d=f; 

FROM=FROM + l; 

DS ST I NA T I ON = DESTINATION + 1J 

end; 

END move; 



FILL: PROCEDURE (DESTINATION .COUNT , CHAR ) J 
DECLARE (DESTINATION, COUNT) ADDRESS, 

( CHAR ,D EASED DESTINATION) BYTE; 
DO WHILE ( COUNT:=CCUNT - 1)0 0FFFFH ; 

d=char; 

DESTINATION=DESTINAT ION + 1J 

end; 

end fill; 



CONVERT^ TOiHEX : PROCEDURE ( POI NTER , COUNT ) ADDRESS; 

DECLARE POINTER ADDRESS, COUNT BYTE ; 

A$CTR=0 J 

base=pointer; 

DO CTR = 0 TO COUNT-1 ; 

A$CTR=SHL ( AiCTR ,3 ) + SHL(A$CTH,1) + BiBYTE(CTR) - '0' 

end; 

RETURN A^CTRJ 
END CONVERT$TO$HEX; 



/* * * * * CODS CONTROL PROCEDURES * * * * */ 
DECLARE 

BRANCH$FLAG BYTE initial( false); 

INCiPTR : PROCEDURE (COUNT); 

DECLARE COUNT 3YTS5 

PROG RAM £ COUN TER= PRO GR AM $ COUNTER + COUNT; 

END incsptr; 



GET iOP^CODE : PROCEDURE BYTE; 
CTR=CiBYTE (0 ) ; 

CALL INC$PTR(1); 

RETURN CTR; 

end get^op^code; 



COND$BRANCH: ?ROCEDURS( COUNT ) ; 

/* THIS PROCEDURE CONTROLS BRANCHING INSTRUCTIONS */ 



230 



DECLARE COUNT BYTE? 

IE BRANCH$FLAG THEN 

do; 

bp.anch$flag=false; 

PROGRAM$COUNTER=C$ADDR( COUNT) ; 

end; 

ELSE CALL INC$PTR ( SHL ( COUNT, 1 ) +2 ) J 

END cond$branch; 



INCR$0RA BRANCH: PROCEDURE ( MARK ) ; 

DECLARE MARK BYTE; 

IF MARK THEN CALL INC$PTR(2); 

ELSE PROGRAMACOUNTER=C$ADDfi( 0) ; 

END incr$or$branch; 

/* * * * * ^COMPARISONS **#**£**/ 



CEAR$COMPAPZ: PROCEDURE 3YTE; 

BASE=C*ADDR(0); 

HOLD=C$ADDR(l) J 

DO A $CTR=0 TO C$ ADBR ( 2 ) - l; 

IF B$ BYTE( AACTR) > H$ BYTE ( A$C TR ) THEN RETURN 1J 
IF B$BYTE( A$CTR) < H$3YTE( A$CTR) THEN RETURN 0J 

end; 

RETURN 2; 

end cearAcompabe; 



STRINGACOMPARE: ?ROCSDURE( PIVOT) ; 

DECLARE PIVOT BYTE? 

IF CHAR ACOMP APE=PI VOT THEN BPANCH$FLAG=NOT 3RANCH$FLAG 
CALL C0ND$BRANCH(3); 

END STRINGACOMPARE? 



NUMERIC: PROCEDURE( CHAR ) BYTE; 

DECLARE CHAR BYTE J 

RETURN (CHAR >='0') AND (CHAP < = '9'),* 

END numeric; 



LETTER: PROCEDORE(CH«R) BYTE; 

DECLARE CHAR BYTE; 

RETURN (CHAR >='A') AND (CHAR <='Z')J 

END letter; 



SIGN: PROCEDURE ( CHAR ) BYTE; 

DECLARE CHAR BYTE? 

RETURN (CHAR='+') OR ( CHAR='- ' ) 5 
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END sign; 



COMP$NUM$UNSIGNED: PROCEDURE; 
BASE=C$ADDR(0); 

DO A$CTR=0 TO C$ADDR(2)-1,* 

IF NOT NUMERIC (B$BYTE(A$CTR) ) THEN 

do; 

bp anch£flag=not branch$flag; 
return; 

end; 

end; 

CALL C0ND$BRANCH(2) ; 

END COMPiNUMiUNS IGNEDJ 



COMP$ NUM£S IGN : PROCEDURE; 

BASE=CSADDR(0); 

DO AiCTR=0 TO C$ADDR(2)-i; 

IF NOT ( NUMERIC ( CTR : =B$BYTE ( A$ CTR ) ) 
OR SIGN ( CTR ) ) THEN 

DC? 

BRANCH$FL AG=NOT BRANCH$ FLAG ; 
RETURN ; 

end; 

end; 

CALL C0ND$3RANCH (2) ; 

END COMPiNUM$S IGN; 



COMP^ ALPHA : PROCEDURE; 

BASE=Ci ADDR (0 ) ; 

DO A$CTR=0 TO C$ADDR(2)-i; 

IF NOT LETTER ( 3$BYTE(A$CTR)) THEN 

do; 

BF ANCH$FL AG=NOT BR ANC3$FLAG ; 

return; 

end; 

end; 

CALL C0ND$3RANCH(2) ; 

end ccmp$alpea; 



/* * * * * ^NUMERIC OPERATIONS * * * * * */ 



DECLARE 



(R0,R1,R2) (10) 

SIGN0 ( 3) BYTE, 

(DEC$PT0 ,DEC$PT1 ,DECi?T2) 
DECiPTA (3) BYTE AT 

OVERFLOW BYTE, 



3YTE , /* REGISTERS */ 
BYTE, 

. DEC $?T0 ) , 
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R$ PTR 
SWITCH 



BYTE 

BYTE 

BYTE 

LIT 

LIT 

LIT 



SIGNIFSNO 

ZONE 




POSITIVE 

NEGITIVE 



CHECKS FOR$SIGN: PROCEDURE ( CHAR ) BYTE; 

DECLARE CHAR BYTE; 

IF NUMERIC (CHAR) THEN RETURN POSITIVE; 

IF NUMERIC (CHAR - ZONE) THEN RETURN NEGITIVE; 

CALL print$ehror('si'); 

RETURN POSITIVE? 

end check$for$sign; 



STORES IMMEDIATE: PROCEDURE; 
DO C TR=0 TO 9; 

R0(CTR)=R2(CTR); 

end; 

DEC$?T0=DEC$PT2; 

SIGN0(0)=SIGN0(2)J 

END storeSimmediate; 



ONESLEFT: procedure; 

DECLARE (CTR, FLAG) BYTE; 

IF ( (FLAG :=SHR( B$BYTE (0 ) ,4) )=0) OF. ( FLAG =9 ) THEN 

do; 

DO CTR=0 TO e; 

B $ BYTE ( CTR )=S HL ( B$BYTE ( CTR ) , 4 ) OR 
SHR ( B$BYT E( CTR + 1 ) ,4) ; 

end; 

BSBYTE(9)=SHL ( B$BYTE (9 ) , 4 ) OR FLAG; 

end; 

else overflcw=true; 
end onesleft; 



ONE$RIGHT: procedure; 
declare ctr byte; 

CTR=10; 

DO INDEX=1 TO 9; 

CTR=CTR-i; 

BS3YTS(CTR)=SER(B$3YTE(CTR),4) OR 
SHL ( B$3YTE( CTR-1 ) ,4)1 



END? 

3$BYTE(0)=SHR(BSBYTE( 0) ,4) 
IF B $BYTS ( 0 ) = 09H THEN 



bSbyte ( 0 ) = 9sh; 



end oneSright; 
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SHI FT$RI GHT : PROCEDURE! COUNT ) ; 
DECLARE COUNT BYTE > 

DO CTR=1 TO COUNT; 

CALL one$right; 

end; 

end shift$right; 



SHI FT$LEFT : PROCEDURE (COUNT); 
DECLARE COUNT BYTE; 

overflow=f.alse; 

DO CTR=1 TO COUNT; 

CALL one$left; 

IF OVERFLOW TEEN RETURN; 

end; 

end shift$left; 



ALLIGN: PROCEDURE; 

B ASE = .R0 J 

IF DEC^PTO > DEC^PTl THEN 
CALL SHIFT$RIGHT(DEC$PT0-DEC$PT1) J 
ELSE CALL SHIFT$LEFT( DEC$PT1-DEC$PT0 ) ; 
END allign; 



ADD$R0: PROCEDURE! SECOND, DEST); 

DECLARE ( SECOND , DEST) ADDRESS, (CY,A,5,I,J) BYTE 

hold= second; 

BASE = DEST; 

cy=o; 

CTR=9; 

DO J=1 TO 10; 

A=R0 ( CTR ) J 
B=H$BYTE(CTR); 

I=DEC (A+CY) ; 

cy=carry; 

I=DEC ( I + B); 

CY=( CY OR CARRY) AND l; 

Bi3YTE( CTR )=i; 

CTR-CTR-1J 

end; 

I? CY THEN 

do; 

CTR=9; 

DO J = 1 TO 10 ; 

I=3$BYTE( CTR) J 
I=DEC ( I +C Y) ; 

CY=CARRY AND 1J 
B$BYTE( CTR) = I i 
CTR=CTR-1 ; 

end; 

end; 

END ADD$R0 ; 
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COMPLIMENT : PR 0 C EDUR E ( N UM B ) ; 
DECLARE NUMB BYTE; 



S IGN 0 ( NUMB ) = S IGN0 (NUMB ) XOR 1J 

DO CASE numb; 

HO LD= .R 0 ; 

H0LD=.R1J 

H0LD=.R2? 

end; 



/* COMPLIMENT 
SIGN */ 



DO CTR=0 TO 9J 

H$BYTE( C'TR )=99H - H^3YTE( CTR ) ; 

end; 



end compliment; 



R2$ZER0: PROCEDURE BYTE,* 

TWCTt'QV T DYTT?* 

IF (SHL(R2(0) ,4)00) OR (SHR( R2(9) ,4)00) 
THEN RETURN FALSE; 

ELSE DO 1=1 TO 8; 

IF R2( I )<>0 THEN RETURN FALSE? 

end; 

RETURN TRUE; 
end R2$zero; 

CHECKiRESULT: PROCEDURE; 

IF S HR ( R2 ( 3 ) , 4 ) =9 THEN CALL COMPLIMENT (2 ) 5 
IF SHR(R2(0) ,4)00 THEN OVERFLCW=TEUE *, 

END check$result; 



CHECK^SI GN : PROCEDURE; 

IF S IGN0( 0 ) AND SIG.N0 ( 1 ) THEN 

do; 

SIGN0(2)=?OSITIVE; 

return; 

end; 

SIGN0(2)=N3GITIVS; 

IF NOT S IGN0 ( 0 ) AND NOT SIGN0(1) THEN RETURN; 
IF S IGN0 ( 0 ) THEN CALL COMPLI MSNT ( 1 ) J 
ELSE CALL C0M?LIMENT( 0 ) ; 

END check^sign; 



LEADI NG$ ZEROES : PROCEDURE ( ADDR ) BYTE; 
DECLARE COUNT BYTE, ADDR ADDRESS ; 
COUNT=e; 
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BASE=ADDRJ 
DO CTR=0 TO 9? 

IF (B^3YTS( CTR ) AND 0F0H) <> 0 THEN RETURN COUNT 
COUNT=COUNT + 1? 

IF (B$BYTE( CTR ) AND 0FH ) <> 0 THEN RETURN COUNT; 
COUNT=C OUNT + 1J 

end; 

RETURN COUNT; 

END LEADING$ZERCES; 



CHECX$DECIMAL : PROCEDURE; 

IF DEC? PT2<> ( CTR : = C$BYTE ( 3 ) ) THEN 

do; 

BASE= . R2 J 

IF DSC$ PT2 > CTR THEN CALL SHIFT$RIGHT( DSCi PT2-CTR ) 
ELSE CALL SHIFTS LEFT ( CTR-DEC$?T2 ) ; 

end; 

IF LEAD I NG$ ZEROES ( . R2 ) < 19 - C^BYTE(2) THEN OVERFLOW 

= true; 

end check$decipal; 



ADD: PROCEDURE,* 

overflow=false; 
call allign; 
call check$sign; 

CALL ADDR0 ( . R1 , . R2 ) ; 
CALL CHECKiRESULT ; 
END ADD; 



ADD^SERISS: PR CCSDURE (C OUNT ) J 
DECLARE (I, COUNT) 3 YT E ; 

DO 1=1 TO count; 

CALL ADD$R0( .R2, .R2) J 

end; 

END ADD$SERIES; 



SET^MULT iDI V : PROCEDURE; 

overflow=false; 

SI GN0 ( 2 ) = (NOT (SIGN0I0) XOR SIGN0(1))) AND 01HJ 
CALL FILL( . R2 , 10 ,0 ) } 

END setAmult$div; 



Rl^GREATER: PROCEDURE BYTE; 

DECLARE I 3YTEJ 
DO CTR=0 TO 9; 

IF R1 (CTR)>(I:=99H-R0(CTR) ) THEN RETURN TRUE; 
IF RXCTRXI THEN RETURN FALSE; 

end; 

RETURN TRUE; 
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END R1 ^GREATER; 



MULTIPLY: PROCEDURE ( VALUE ) ; 

DECLARE VALUE BYTE? 

IF VALUEO0 THEN CALL ADD$SERIES ( VALUE ) ; 
3ASE=. R0 J 

call onesleft; 

END multiply; 



DIVIDE: PROCEDURE? 

DECLARE (I, J, K, LZ0, LZ1, X) BYTE; 

CALL SET$MULT$DIVJ 

IF ( LZ0 : =LE ADI NG$ ZEROES ( . R0 ) ) <> 

(X := ( LZ1 := LEAD ING$ZEP.0ES ( .Rl) ) ) 

do; 

IF LZ0>LZ1 THEN 

do; 

BASE = .R0; 

CALL SHIFT$LEFT ( I := LZ0-LZ1); 
DEC$PT0=DEC$PT0 + IJ 
X = lzi; 

end; 

else do; 

BASE = .Rl ; 

CALL SHIFTSLSFT ( I :=LZ1-LZ0 ) J 
DEC$PT1=DECPT1 + I? 

X = LZ0 ; 

end; 

end; 

DECPT2= 18 - X + DECPT1 - DFCPT0 ; 

CALL COMPLIMENT (0)5 
DO I = X TO 19; 
j=0 ; 

DO WHILE RliGRSATER; 

CALL ADD$R0( .Rl, .Rl) J 
IF Rl ( 0 ) = 993 THEN 

CALL COMPLIMENT ( 1 ) J 

j=j+i; 

end; 

K=SHR(I ,1); 

IF I THEN R2 ( X )=R2 ( X ) OR j; 

ELSE R2 ( 5 )=R2 ( K ) OR SHL(J,4); 

3ASE= .R0 ; 

CALL ONEiRIGHTJ 

end; 

end divide; 



LO AD$ A$CHAP : PROCEDURE( CH»R) ; 
DECLARE CHAR BYTE; 



THEN 
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IF ( SWITCH : = NOT SWITCH) THEN 

B$BTTE(R$PTR)=B$BYTS(R?PTR) OR SHL ( CHAR - 30H,4)J 
ELSE E$BYTE(R$PTR :=R$?TR-1 )=CHAR - 30H ; 

END loadsa^char; 



LOAD$ NUMBERS : PROCEDURE ( A DDP , CNT ) ,* 

DECLARE ADDR ADDRESS, ( I , CNT ) BYTE ; 

hold=res(addr); 

ctr=cnt; 

do INDEX = 1 to cnt; 
ctr=ctr-i; 

CALL LOAD$A$CHAR(H$BYTE(CTR ) ) ; 

end; 

CALL I NCiPTR ( 5 ) J 
END LOAD^NUMBERS; 



SET$LOAD : PROCEDURE (SIGN$IN)J 
DECLARE SIGN^IN BYTE? 

DO CASE ( CTR : =C$BYTE( 4 ) )J 
BASE= ,R0; 

3ASE=.Ri; 

BASE= .R2; 

end; 

DEC^PTA ( CT P )=C $BYTE ( 3 ) J 
SlGN0(CTR)=SIGN$IN; 

CALL FILL (BASE, 10,0); 
R$PTR=9J 

switch=false; 
end sstHoad; 



LOADiNUMERIC: PROCEDURE; 

CALL SET$ LOAD ( 1 ) J 

CALL LOAD $ NUMBERS ( C$ADDR ( 0 ) , C^BYTE ( 2 ) ) J 
END LOAD$NUMERIC; 



LOAD$NUM$LIT: PROCEDURE; 

DE CLARE ( LIT$S IZE ,FLAG ) BYTE*, 

CHAR$S IGN : PROCEDURE; 

LIT^S IZE=LIT$S IZE - l; 
HOLD=HOLD + 15 
END CHARTS IGN ; 

LIT$SIZE=C$3YTE(2) 5 
HOLD=C$ADDS(0) J 
IF HiBYTS( 2)='-' THEN 

do; 

CALL CHARTS IGN J 

CALL SET$LOAD( NEGITI VE) ; 

end; 
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ELSE DC; 

IF H$BYTE ( 0 )= ' + ' THEN CALL CHAR$5IGN; 
CALL SET$ LO AD ( POSITIVE) ; 

end; 

FLAG=0 J 

ctr=lit$size; 

DO I NDEX=1 TO LIT$SIZS; 

ctp-ctr-i; 

IF H$ BYTE( CTR ) = ' . ' THEN FLAG=LIT$SI ZE 
ELSE CALL L0AD$A$CHAR(E$3YTE(CTR ) ) J 

end; 

DEC$PTA(C$BYTE(4) )= FLAG; 

CALL I NCiPTR ( 5 ) J 

end load$num$lit; 



STORE$ONE : PROCEDURE; 

IF( SWITCH : =NOT SWITCH) THEN 

B$ BYTE ( 0 ) =S HR( H$3YTE ( 0 ) ,4) OR '0 ' 5 
ELSE do; 

HOLD=HCLD-i; 

B$3YTE(0) = (H$BYTE( 0) AND 0FH ) OR '0'; 

END; 

BASE=BASE-i; 

END stors^one; 



STORE$AS ^CHAR : PROCEDURE( COUNT) J 
DECLARE COUNT 3YTEJ 

switch=false; 

H0LD=.R2 + 9; 

DO CTR=1 TO COUNT; 

call stof.e$one; 

end; 

end store$as$cbar; 



SET$ZONE : PROCEDURE (AD DR); 

DECLARE AD DR ADDRESS; 

IF NOT S IGN0 ( 2 ) THEN 

do; 

base=addr; 

B$BYTE ( 0 ) =B S3YTE ( 0 ) OR ZONE; 

end; 

CALL INCiPTR(4); 

END setszons; 



SET$SIGN $S£P : PROCEDURE ( ADDR ) ; 
DECLARE ADDR ADDRESS; 

base=addr; 

IF S IGN0 ( 2 ) THEN 3$BYT E ( 0 ) = ' ; 

ELSE B$BYTE(0)='-'J 
CALL I N C $ ? TR ( 4 ) J 



(CTR+1) ; 



239 



END SETASIGNASEP; 



STCREAnUMER.IC: PROCEDURE; 

call ceeckAdecimal; 

BASE=CA ADDR ( 0 ) + CABYTS(2) -1 ; 

CALL storeAasachar(c$byte(2) ); 
END storeAnumeric; 



/***** INPUT-OUTPUT actions ******/ 



DECLARE 



'36' , 

uc/ 9 
' 12 ', 
'32 ', 
'IV', 
'128' , 
'CR ', 

' 1AH ' , 
'0FFH ' , 



INITIAL ( 0H ) , 



E0FAELAG50FFSET 

FLAGAOFFSET 

EXTENT AOFFS ET 

REC$NO 

PTRAOFFSET 

BUFFALENGTH 

VAR ASND 

TERMINATOR 

BIGE$V ALUE 

INVALID 

REWRITEA FLAG 

RANDOMAFILE 

CURRZNTAFLAG 

FCBABYTS 

fcbAaddr 

fceaeyteaa 

fceaaddrAa 

buffAptr 

BUFFASND 

BUFFS TART 

BUFFA3YTE 

CONABUFF 

C0NS3YTS 

CONAINPUT 



LIT 
LIT 
LIT 
LIT 
LIT 
LIT 
LIT 
LIT 
LIT 
BYTE, 

BYTE 
BYTE, 

BYTE, 

BASED CURRENTAFCB 
BASED CURRENTAFCB 
BASED CURRENTAFCB 
BASED CURRENTAFCB 
ADDRESS , 

ADDRESS , 

ADDRESS , 

BASED BUFFAPTR 
ADDRESS INITIAL 
BASED CONABUFF 
ADDRESS INITIAL 



3YTE , 
ADDRESS, 
(1) BYTE, 

(1) ADDRESS, 



3YTE , 
( 83H ) , 
BYTE, 
( 32H ) * 



ACCEPT: PROCEDURE; 

CALL cp.lf; 

CALL PRINTACHAR(3FH); 

/# CALL CRLFJ # / 

CALL FILL( CONAINPUT, ( CONA BYTE : = CA 3 YTS ( 2 ) ), ' '); 
CALL READ ( CONABUFF) ; 

CALL MOVSvCONAINPUT ,RES (CAADDR(0) ) ,CCN$3YTE); 
CALL incAptr(3); 

END accept; 
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DISPLAY: PROCEDURE; 

DECLARE 3$CNT BYTE; 

BASE=C$ ADDS ( 0 ) ; 

IF NOT C$B YTE ( 3 ) TEEN CALL CRLF; 
B$CNT = C$3YTE(2 ); 

DO CTR = 0 TO B$ CNT - 1J 

CALL PRINT$CHAR(B^BYTE(CTR) ) ; 

end; 

CALL INC$PTR(4); 

END display; 



GET $FILESTYPE: PROCEDURE BYTE; 
BASE=C$ADDR(0) ; 

RETURN BS3YTE(FLAGSCFFSET); 
END gst$file$type; 



SET$FILE$TYPE: PROCEDURE( TYPE ) ; 

DECLARE TYPE BYTE? 

BASE=C$ADDR(0); 

IF GET$FILE$TYPE<>0 THEN CALL FAT ALSERROR ( 'OE ' ) ; 

b$byte(flag$offset)=type; 
end set$file$type; 



SET$I SO : PROCEDURE; 
invalid=false; 

IF C SADDR ( 0 ) =CURRENTS FCB THEN RETURN; 

/* STORE CURRENT POINTERS AND SET INTERNAL 
WRITE MARK */ 

bass=current$fcb; 

FC3S ADDR$ A ( PTRS OFFSET ) =3UFFS ?TR ; 

fcb£byte$a(flag$offsst)=current$flag; 

/* LOAD NEW VALUES */ 

BUFF SEN D= ( BUFFS START : =( CURRSNTSFCB : =CS ADDR ( 0 ) ) 
+ S TART$OFFSET ) + BUFFSLENGTH; 
CURRENT$FLAG=FCBSBYTESA ( FLAGS OFFSET ) ; 

BUFFS ?TR=FC3S ADD R$A ( P'TRSOFFS ET ) ; 

END SETS I $0 ? 



OPENSFILE : PROCEDURE (TYPE ) ; 

DECLARE TYPE BYTE; 

CALL SETSFILESTYPE(TYPE); 

CTR=OPEN ( CURRENT SFC3: =C $ ADDR (0 ) ) ; 

DO CASE TYPS-i; 

/* INPUT */ 

do; 

IF CTR=255 THEN CALL FATAL$ERROR( 'NF ' ) 

end; 

/* OUTPUT */ 

do; 



CALL delete; 

CALL MAKE (C?ADDR(0 ) ) ; 



end; 

; /* CASE 2 NOT USED */ 

/* 1-0 */ 
do; 

IF CTR=255 THEN CALL F AT ALS E RRO R ( ' N F ' ) J 

end; 

end; 

FC3?BYTE?A (EXTENT?OFFSET)=0; /* SET THE EXTENT FIELD 

IN FCB */ 

FC3?BYTE?A(REC?NO)=0; /* SET THE RECORD NUMBER 

IN FCB */ 

FCB?3YTE?A(ECF?FLAG?0FFSET)=FALSE; 

/* SET THE EOF INDICATOR OF? */ 
BUFF?END= ( BUFFOS TART : = ( CURRENTS FCB + ST ART?OFFSET ) ) 

+ EUFF?LENGTH 5 

CURRENT?FLAG=FC3?3YTE$ A ( FLAG $ OFFSET ) 5 
BUFF?PTR,FCB?ADDH?A (FTP. ^OFFSET ) =3UFF?START-1 ? 

CALL INC$PTR(2); 

END open?file; 



WRITE?MARK: PROCEDURE BYTE; 

RETURN ROL (CURRENT? FLAG ,1 ) J 
end white?mark; 



SET?WPITE$MAEK : PROCEDURE; 

CURRENT$FLAG=CURREN TiFLAG OR 30H; 
END set?write?marx; 



WRI TE?RECORD : PROCEDURE; 

CALL set?dma; 

CURRENT?FL AG=CURRENT? FLAG AND 0FHJ 
IF ( CTR :=DISK?WRITE ) =0 THEN RETURN; 
CALL PRI NTSERRCR ( 'W3' ) ; 
invalid=true; 

END write?record; 



READ? RECORD : PROCEDURE? 

CALL SiIT$DMAJ 

IF WRITE? MARK THEN CALL WRITE?RSCORD 5 
IF ( CTR:=DISK?READ)=0 THEN RETURN; 

IF CTR=1 THEN FC3?EYTE?A( ECF? FLAG? OFFSET )=TRUEJ 

invalid=true; 
end read?recop.d; 



READ? BYTE : PROCEDURE BYTE; 

IF ( 3UFF?PTR : =3UFF??TR + 1 ) >= 3UFFEND THEN 

do; 
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CALL HE AD$ RECORD; 

IF FCB$EYTESA( EOFS FLAGS OFFSET ) THEN 
RETURN TERMINATOR? 

buff$?tr=3uff$star.t; 

END* 

RETURN 3UFFS3YTE; 

END readSbyte; 



WRI TE$BYT2 : PROCEDURE (CHAR); 

DECLARE CHAR EYTEJ 

IF (BUFF$?TR:=BUFF$?TR+1) >= 3UFF$2ND THEN 

do; 

CALL writeSrscord; 

BUFF$PTR=3UFF$START; 

IF REWRITE? FLAG THEN 

dc; 

CALL RSADi RECORD? 

FCB$BYTS$A(RECSNO )=FC3SEYTESA( RECSNO)-i; 

end; 

end; 

CALL SET$WRITE$MARK J 
3UFF$3YTE=CHAR; 
end wpiteSbyte; 



WRITS$END$MARK : PROCEDURE; 
CALL WRITE SB YTE ( CR ) J 
CALL WRITESBYTE(LF) J 

end writeSendSmarx; 



FEAD$INDSMARX: PROCEDURE; 

IF READSBYTEOCR teen call PRINTS ERROR ( 'EM') ; 
IF READ$3YTEOLF TEEN CALL PRI NTS ERROR (' EM ') ; 
END READ $ENDSM *PK ; 



R EADS VAR I AB LE : PROCEDURE ; 

CALL SETS I SC; 

BASE=CSADDR(1) ; 

DC A^CTR-0 TO CSADDR(2)-i; 

IF (CTR:=(BSBYTE( ASCTR) :=READSBYTE) ) = VARSEND TEEN 

do; 

ctr=readSbyte; 

return; 

end; 

if ctr=terminator then 
do; 

fcbsbyte$a(eofsflagsoffset ) =TRUE; 
return; 

end; 

end; 

call readsendsmarx; 
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END READ $ VARIABLE ? 



WRITEiVARlABLS: PROCEDURE ? 

DECLARE COUNT ADDRESS? 

CALL SETA I SO? 

base»csaddb(i); 

COUNT = C$ ADDR ( 2 ) ? 

DO WHILE ( 3 $BYTE ( COUNT : =C CUNT-1 )<> ' ' ) AND (COUMTO0) 
END? 

DO A$CTP.=0 TO COUNT? 

CALL WRITE$3YTE(363YTE(A$CTR) )? 

END? 

CALL WRITER END iMARK ? 

END WRITESVAR IARLE? 



READ$TO*MEMORY : PROCEDURE? 

EASE=C$ADDR( 1 ) ? 

DO A$CTR=0 TC C$ADDR(2)-1? 

IF (B$ B YTS( A$CTR) :=RSAD£BYTS)=TERMINAT0R THEN 
DO? 

7CB$3YTE$A( ECFi FLAG ^ OFFSET ) =TRUS? 

RETURN ? 

END? 

END? 

CALL READ $EN D-MARK ? 

END READ $ TO S MEMORY ? 



WRITES FROM* MEM CRY : PROCEDURE? 

3ASE = C$ ADDR ( 1 ) ? 

DO ASCTR=0 TC C$ADDR( 2 ) -1 ? 

CALL WRITE$BYTE(3$3YTE( A $ C TR ) ) ? 

END? 

CALL WRITS SENDS MARK ? 

END WP I TESF ROM $ MEMORY ? 



/* * * * * RANDOM 1-0 PROCEDURES * * * */ 



SETSR ANDOMSPOI NTER : PROCEDURE? 

/* 

THIS PROCEDURE READS THE RANDOM KEY AND COMPUTES 
WHICH RECORD NEEDS TC RE AVAILA3LS IN THE 3UEESR 
THAT RECORD IS MADE AVAILABLE AND THE POINTERS 
SET FOR INPUT OR OUTPUT 
515 / 

DECLARE (BYTSSCOUNT, RECORD) ADDRESS, 

EXT' 5 ' NT 3 YTE J 

IF WRITE$MARK THEN CALL WRI TSSRSCORD ? 

BYTE SCOUNT = ( CS ADDR( 2) +2 )* ( CONVERT STOS HEX ( C* ADDR ( 3 ) 
,CS3YTE(e) )-!)? 
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RECORD=SER (BYTS$COUNT ,7 ) ; 

EXTS.NT=SHR (RECORD, 7 ) ; 

IF EXTEMT< >FCBSBYTE$A( EXTENT^ OFFS ET ) THEN 

do; 

CALL CLOSE(C$ADDR(0) ),' 

FCB$ BYTES A ( EXTENT $0FFSET)=3XTENT; 

IF OPEN ( CSADDR ( 0 ) )<>0 THEN 

do; 

IF SHR ( CURREN TSFLAG , 1 ) THEN CALL MAXE( C$ ADDR ( 0 ) ) ; 
ELSE INVALID=TRUE5 

end; 

end; 

BUFF$PTR=( BYTE$COUNT AND 7FH ) + BUFFSSTART -1J 
FCBSBYTESA (32 )=LOV( RECORD) AND 7FH ; 

CALL READ$RECORD; 

end setsrandom$pcinter; 

GET SRECS NUMBER : PROCEDURE ADDRESS; 

DECLARE (RECORD , LOG I CAL $R ECS NUM .BYTES COUNT ) ADDRESS; 
RECORD=SHL ( FCBSBYTESA ( SXTS NTSOFFS ET ) ,7) 

+ fcbSbyteSa (rec$no ); 

IF NOT SHR ( CURRENTS FL AG, 1) THEN RECORD=nSCORD-l 5 
RYTESCCUNT=SHL(RSC0RD ,7 ) + ( ( BUFFS ?TR+ 1 ) -BUFFS ST ART ) ; 
L0GICALSRECSNUM=(BYTESC0UNT/(CSADDR(2) +2) )+i; 

RETURN LOG ICALSR ECS NU V J 
END getSrecSnumber; 

SETSRELATIVESKEY: PROCEDURE; 

DECLARE ( RECSNUM , £) ADDRESS, 

/ i CNT) 3YTS 

J ( 4 ) ADDPESs’DATA (10000,1000,100,10), 

BUFF ( 5 ) EYTE; 

recsnum=getsrscS number; 

DO 1=0 TO 3; 

CNT=0; 

DO WHILE RECSNUM>= ( K : =J (I ) ) 5 

recSnum=recSnum - x; 

CNT=CNT + l; 

end; 

BUFF ( I ) =CNT + '0'; 

end; 

BUFF(4)=RSC$NUM+'0'; 

IF ( I:=CS3YTE(S) )<=5 THEN 

CALL MOVE( .BUFF+5-I .CSADDR (3 ) ,1 ) ; 

else do; 

CALL FILL f CSADDR(0) ,1-5, ' ' ) 5 

CALL MOVE( .BUFF, CS ADDR ( 3 ) +1-6 , 5); 

end; 

end setSrelativeSkey; 

WRI TESEM PTYSRSCORD : PROCEDURE; 

DO A SCTR=1 TO C$ADDR(2) J 

call writeSbyte(highsvalue); 

end; 
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CALL WRITESSNDSMARK? 

2ND writeSemptysrecord; 

WRITESDUMMYSRECORDS : PROCEDURE (DIFFERENCE ) ; 

DECLARE DIFFERENCE ADDRESS, COUNT BITE; 

DO COUNT=l TO difference; 

CALL writeSemptysrecord; 
end; 

END WRITESDUMMYSRECORDS J 

BACKSONESEXTENT: PROCEDURE; 

CALL CLOSS(C$ADDR(0)) ; 

IF FCBSBYTES A ( EXTENTS OFFSET ) : = 

FCB S BYTES A ( EXTENTS OFFS ET ) -1=255 THEN 
CALL FAT AL$ ERROR ( ' W7 ' ) ; 

IF OPEN(CSADDR(0) )<>0 THEN 

do; 

CALL PRINT$ERRO?.( 'OP'); 

invalid=true; 

return; 

end; 

FCBSBYTES A (RECSN0)=127; 

END BACKSONESEXTENT; 

BACKS ONES RECORD : PROCEDURE; 

IF(Bu'FFSPTR:=5UFFSPTR-(CSADDR( 2) +2) ) >=3UFF$START-1 THEN 

do; 

FCBSBYTESA(REC$N0)=FCB$3YTISA(RECSN0)-1 ; 

return; 

end; 

buff$?tr=buff$end-(buffSstart-buffsptr) ; 

IF ?CB$3YTESA(REC$NC )=0 THEN 

do; 

CALL BACKSONESEXTENT; 

IF INVALID THEN RETURN 5 

CALL readSrecord; 

CALL BACKSONES EXTENT; 

end; 

ELSE 

do; 

FCBSBYTSSA(RECSNO)=FC3$3YTESA(RZCSNO )-2 ; 

CALL READSRECORD; 

FCBSBYTESA(RECSNO)=FCB$3TTESA(RECSNO)-i; 

end; 

END BACKS ONES RECORD; 

REWRITES SEO : ?ROCEDURE( FLAG ) ; 

DECLARE FLAG BYTE; 

CALL BACKSONESRECORD; 

rewrite$flag=true; 

IF FLAG THEN CALL *R ITES FRCMSMEMORY ; 

/* THIS IS A REWRITE */ 

ELSE CALL WR ITES EMPTY SR SC OR D J /* THIS IS 

A DELETE */ 
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CALL WRI?E$RECORD? 

FCP5?BYTE$A(REC$N0)=FCB$BYTE$A(REC$N0)-1? 

rewrite$flag=false? 
call read$hecord; 
end rewrite$seq? 

CEECK$DI FFEREN CE : PROCEDURE ? 

DECLARE (DIFFERENCE, NEXT$RECORD , NEXTSKSY ) ADDRESS? 
NEXTSRECORD=GST$REC$NUMBER? 

NEXTSXEY =CONVE RT$TO$ HEX ( C$ A.DDR ( 3 ) , C$3YTE ( 5 ) ) ? 

IF NEXT5RECCRD > NEXT$KEY THEN CALL FAT AL$ ERROR ( 'W2 ' ) ? 
DI FFERENCE= NEXT $ X EY- NEX T$ RE CORD ? 

IF DIFFERENCE > 0 TEEN 

CALL WR I TES DUMMY $ RECORDS (DIFFERENCE ) ? 

END C HECXS DIFFERENCE ? 

/# # * * # # # l^O VES *******/ 



I NC $HOLD : PROCEDURE? 
HOLD=HOLD + 1? 
CTR=CTR + 1? 

END I NC$HOLD ? 



LOAD$ INC : PROCEDURE? 

H$3YTE ( 0 ) =3$BYTE ( 0 ) ? 
BASE=BASF+1 ? 
CTR1=CTR1 + 1? 

CALL INCSEOLD? 

END LOADS I NC ? 



CHECK^EDIT: PROCEDURE ( CHAR ) ? 

DECLARE CHAR BYTE? 

IF (CHAR='0') OR ( CHAR= '/ ' ) THEN CALL INCSEOLD? 

ELSE IF CHAR='3' THEN 
DO? 

H$3YT S ( 0 ) = ' '? 

CALL INC$H0LD? 

END? 

ELSE IF CHAR='A' THEN 
DO? 

IF NOT LETTER ( B ^BYTE ( 0 ) ) THEN CALL PR iNTiERROR ( ' IC ' ) ? 
CALL LOAD$INC? 

END? 

ELSE IF CHAR* '9' TEEN 
DO? 

IF NOT NUMERIC (3$3YTE(0)) THEN 
CALL PRINTS ERROR ( ' IC ' ) ? 

CALL LOAD$I NC ? 

END? 

ELSE CALL LOADilNC? 

END CHSCK$EDIT ? 
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* * * MACHINE ACTIONS * * * * 



-r* nr 



* */ 



STOP: procedure; 

CALL PRINT (.('END OF JOB $')); 
CALL bootee; 

END stop; 



THE PROCEDURE BELOV CONTROLS THE EXECUTION OF THE CODE. 
IT DECODES EACH OP-CODE AND PERFORMS THE ACTIONS 



EXECUTE: PROCEDURE; 

do forever; 

DO CASE oet$op$code; 

; /* CASE zero not used */ 

/* 01: ADD */ 

CALL add; 

/* 02: SUB */ 

do; 

CALL COMPLI MENT ( 0 ) ; 

IF S IGN0( 0 ) THEN SIGN0 ( 0 ) =NEG IT IVE J 
ELSE SIGN0(0)*POSITIVS; 

CALL add; 

end; 

/* 03: MUL */ 

do; 

declare i 3Yte; 

CALL SET$MULT$DI7; 

DECPT1 , DECPT2=DEC?T1 + DECPT0 ; 

CALL allign; 

CALL MULTIPLT(SHR(P.1( I :=9) ,4) ) ; 

DO I NDEX=1 TO 9; 

CALL MULTIPLY ( R1 ( I : = I-1 ) AND 0FH ) J 
CALL MULTI? LY(SHR(R1( I) ,4) )J 

END; 

end; 

/* 04: DIV */ 

CALL DIVIDE; 
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/* 05: NEG */ 



3RANCH$FLAG=N0T BRANCH$FLAG > 
/* 06: STP */ 

CALL stop; 

/* 07: ST I */ 

CALL store$immediate; 



/* 09: RND */ 

do; 

call storssimmediate; 
call fill( .R2 , 10 , 0 ) ; 

R2(9)=i; 

CALL add; 

end; 

/* 09: RET */ 

do; 

IF C £ADDR (0)00 THEN 

do; 

A$ CTR=C$ ADDP. { 0 ) ; 

C$ADDR (0 ) =0 J 

program$counter=a$ctr; 

end; 

else call inc$?tr(2); 

end; 

/* 10: CLS */ 

do; 

CALL SET$l£0,' 

IF WRITE$MARK THEN 

do; 

IF NOT SER( CURRENT £ FLAG , 2 ) THEN 
CALL WR I TE$ BYTE (TERMINATOR) ; 
CALL WRITER RECORD; 

end; 

ELSE 

call sst$dma; 

CALL CLOS E ( C$ ADDR ( 0 ) ) ; 

FCB£BYT E£ A ( FLAGS OFFSET ) =0 ; 

CALL I N C £ ?’T R ( 2 ) ; 

end; 

/* 11: SER V 

do; 
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IF OVERFLOW THEN PROGRAMS COUNTER 
= C$ADDR(0)J 
ELSE CALL INC$PTR(2); 

end; 

/* 12: BRN */ 

program$counter=cSaddr(0); 

/* 13: OPN */ 

do; 

CALL OPEN$FILE(l ) ; 

call readSrecord; 
end; 

/* 14: 0P1 */ 

CALL OPENSFI LE ( 2 ) J 
/* 15: 0P2 */ 

do; 

/* 4 IS USED SO EACH TYPE SETS ONLY 
ONE BIT IN CURRENT$FLAG */ 

CALL OPEN $FI LE ( 4 ) ; 

call readSrecord; 
end; 

/* 16: RGT */ 

DC 5 

IF NOT SIGN0( 2 ) THEN 

BRANCH$FLAG=NOT 3RANCH$FLAS; 
CALL C0NDS3RANCH ( 0 ) ; 

end; 

/* 17: RLT */ 

do; 

IF SIGN 0(2) THEN 

BR ANCH$FLAG=NOT BRANCH$FLAG J 
CALL CONDS3RANCH(0) ; 

end; 

/* 18: RSO */ 

do; 

IF R2SZER0 THEN 

BR ANCH$FLAG=NOT 3RANCS$FLAG; 
CALL CONDSBRANCH(0 ) ; 

end; 

/* 19: INV */ 
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CALL INCRS0R$3RANCH(IN VALID) J 
/* 20: EOR */ 

CALL INCR$OR$BRANCH(FCB$BYTE$A(EOF$FLAG$OFFSST) ) ; 
/* 21: ACC */ 

CALL accept; 

/* 22: STD */ 

do; 

C$BYTE( 3 ) =0 ; 

call display; 

CALL stop; 

end; 

/* 23: LDI */ 

do; 

CSADDR(2)=CON7EPTSTOSHEX(C$ADDR(0) 

,csbyte( 2 ) )+i ; 

CALL I N C$ PTP. ( 2 ) ; 

end; 

/* 24: DIS */ 

CALL display; 

/* 25: DEC */ 

do; 

IE CS ADDR ( 0 )<>0 THEN C$ADDR(0) 

= C $ ADDR ( 0 ) -1 J 
IF C$ADDR (0 )=0 THEN 

PROG RAM$ COUNTER = CSADDR(l); 

ELSE CALL INC$PTR(4); 

end; 

/* 26: STO */ 

do; 

CALL STORESNUMERIC; 

CALL INC$PTR(4); 

end; 

/* 27: ST1 */ 

do; 

CALL STORESNUMERIC; 

CALL SET$ZCNE(CSADDR(0) ) ; 

end; 
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/* 28: ST2 */ 



do; 

CALL STORS$MUMERICJ 

CALL SET$ZONE(C$ADDR(0)+C$BYTE(2)-1) ; 

end; 

/* 29: ST3 */ 

do; 

call checkSdecimal; 

BASE=CSADDR (0 ) + CS3YTE(2); 

CALL S TORE $ AS $ CHAR ( C$BYTE( 2 ) - 1); 

CALL SETSSIGNSSEP(C$ADDR(0 ) ) ; 

end; 

/* 30: ST4 */ 

do; 

CALL CHECK SDEC IMAL ? 

3ASE=C$ ADD? ( 0 ) + CS3YTE(2) -i; 

CALL STORES AS$CKAR(C$BYTE(2)-1) ; 

C ALLSETS SIGN$SEP( CS ADDR ( 0 ) +C$ 3YTE( 2 ) -1 ) 5 

end; 



/* 31: STS */ 

do; 

call checkSdscimal; 

R0 ( 9 ) =R 2( 9 ) OR SIGN0(2); 

CALL MOVE ( . R2 + 9 - C $3YTE ( 2 ) , CSADDR ( 0 ) 
,C $3YTE ( 2 ) ) J 
CALL IN CSPTR ( 4 ) J 

end; 

/* 32: LOD */ 

CALL loadsnumSlit; 

/* 33: LD1 */ 

CALL loadSnumeric; 

/* 34: LD2 */ 

do; 

HOLD=C$ADDR( 0) » 

I? CHECK$F0RSSIGN(H$3YT3(3 ) ) THEN 

ro 5 

CALL SETSLO AD (POSITIVE) J 

CALL LOADS NUMBERS ( C$ ADDR ( 0 ) ,C$3YTZ(2) ) 

end; 

else do; 

CALL SSTSLOAD(NEGITIVS) ; 
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CALL LOAD$NUMBERS(C$ADDR(0)+1 
, C$BYTE( 2 )-l ) 5 

CALL LOADAa£CHAR(H$BYTE(0)-ZONE) J 

end; 

end; 

/* 35: LD3 */ 

do; 

DECLARE I BYTE; 

HOLD=C$ADDR(0) ; 

IF CHECKS FOREIGN ( CTR :=H$BYTE ( I : = 
C$BYTE(2)-1) ) THEN 

DO,* 

CALL SET$LOAD(POSITI VE) J 

1 = 1 + 1 ; 

end; 

ELSE DO? 

CALL SET$LOAD(NEGITIVE); 

CALL LOAD$A$CHAR ( CTR-ZONE ) ; 

END; 

CALL L0AD$NUM3ERS ( CSADDR (0 ) ,1 ) ; 

end; 

/* 36: LD4 */ 

do; 

HOLD=C$ADDR(0) ; 

IF(HSBYTE(0)='+') TEEN CALL SET$LOAD(l); 
ELSE CALL S ETSLOAD ( 0 ) J 

CALL LO AD $ NUMBERS ( C$ADDR ( 0 ) , C$BYTE( 2 ) -1 ) ; 

end; 

/* 37: LD5 */ 

do; 

HOLD=C$ADDR(0); 

IF H$B YTE ( C$BYTE ( 2 ) - 1) = '+' THEN 
CALL SET$LOAD(l); 

ELSE CALL SET$LOAD(0); 

CALL LOAD $ NUMBERS ( CSADDR ( 0 ) , CiBYTE( 2 ) -1 ) ; 

end; 

/* 33: LD6 */ 

do; 

DECLARE I BYTE; 

30LD=C$ ADDR (0)5 

CALL SET$LOAD(H$BYTE( I : =C $3YTE( 2 ) -1 ) ) ; 
BASE=BASE +9-15 
DO CTR =0 TO i; 

B$ BYTE (CTS)=H$BYTE( CTR); 

end; 

B$3YTE( CTR) =3S3YTE( CTR ) AND 0F0HJ 
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CALL INC$PTR(5)5 



end; 

/* 39: PER */ 

do; 

BASE=C$ADDR(l)+i; 

E^ADDR ( 0) =C $ ADDR ( 2 ) J 
PROGRAM $COUNTER=C$ADDR (0)5 

end; 

/* 40: CNU */ 

CALL CCMPiNUM$UNS IGNEDJ 
/* 41: CNS */ 

CALL COMP$ NUM$ SI GN ; 

/* 42: CAL */ 

CALL comp^alpha; 

/* 43: RWS */ 

do; 

CALL SET$I$OJ 

IE NOT S HR ( CURRENT $ FLAG , 2 ) THEN 
CALL FATAL$ERROR( 'W6 ' ) J 
IF NOT FCB$BYTE*A(EOF$FLAG$OFFSET) THEN 
CALL REWRI TS$ SEQ ( 1 ) ; 

CALL INC$PTR(6); 

END ; 

/* 44: DLS */ 

do; 

CALL SET$I$0; 

IF NOT SHR ( CURRENT$FLAG , 2 ) THEN 
CALL FATAL$3RR0R( 'W6' ) J 
IF NOT FCB$BYTE$A(EOF$FLAG$OFFS ST ) THEN 
CALL REWRITS$SEO(0) ; 

CALL I NC$PTR ( 6 ) ; 

END ; 

/* 45: RDF */ 

do; 

CALL SET$U0; 

IF NOT CURRENT$FLAG THEN 
CALL FATAL$EF.R0R('W5'); 

IF NOT FCB$3YTE£A( EOF$FLAG$OFFSST ) THEN 
CALL READ$TO$MEMORY ; 

CALL IN Ct PTR( 6 ) ; 
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end; 



/* 46: WTF */ 

do; 

CALL SET$I$OJ 

IF NOT SHR(CURRSNT$FLAG,1) THEN 
CALL FATAL$ERROR ( 'W3 ' ) ; 

CALL WRITE$FROM$ MEMORY » 

CALL INC$PTR(6 ) > 

end; 

/* 47: RVL */ 

CALL READ$7ARI able; 

/* 46: VVL */ 

CALL WRITEiYARlA3LE; 

/* 49: SCR */ 

do; 

SUBSCRIPT (C$3YTE(2) )= 

CONVERT$TO$HEX (C $ADDR ( 0 ) ,C$BYTS(2) ) J 
CALL INC$PTR(4); 

end; 

/* 50: SGT */ 

CALL STRI NG$ COMPARE ( 1 ) J 
/* 51: SLT */ 

CALL STRINGiCOMPARE ( 0 ) J 
/* 52: SEO */ 

CALL S TR I NG$ COMPARE ( 2 ) J 
/* 53: MOV */ 

do; 

CALL M0VE(RES ( C$ADDR( 1 ) ) , RES ( C ^ADDR ( 0 ) ) 

, C$ADDR( 2) )J 

I? C$ADDR(3)<>0 THEN CALL 

FILL(RSS (CSADDR(0) ) + C$ADDR(2) 
,C$ADDR(3),' '); 

CALL INC$PTR(9); 
end; 

/* 54: RRS *7 

do; 
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CALL SET$I$OJ 

IF SHR ( CURRENT$ FLAG , 1 ) THEN 
CALL FATAL$EaaOR( 'W5') J 
IF NOT FCB$BYTE$ A ( EOF $ FLAG ^OFFSET) TEEN 

do; 

call set$rslative$ksy; 
call read$to$memory; 

end; 

CALL INC$PTR(9)J 

end; 

/* 55: WRS */ 

do; 

CALL SET$I$0; 

IF NOT SHR ( CURRENT $ FLAG , 1 ) THEN 
CALL FATAL$ERROR( 'VI ') 5 

CALL checkSdifference; 
call set$rflatiye$key; 
call write$from$memory; 

CALL INC$PTR(9); 

end; 

/* 56: RRR */ 

do; 

CALL SET$I$0; 

IF SHR ( CURRENT $F LAG ,1 ) THEN 
CALL FATAL$3RR0R( 'V5' )J 
CALL SET$RANDOM$POINTERJ 
IF NOT INVALID THEN CALL READ$TO$ MEMORY 
IF VALID THEN 

FCB$BYTE$A( EOF$FLAG$OFFSET ) = FALSEJ 
CALL INC$PTR(9)J 

end; 

/* 57: WRR */ 

do; 

DECLARE DIFFERENCE ADDRESS; 

CALL SST$I$0; 

IF SHR( CURRENT $ FLAG, 1 ) THEN 

do; 

call check$difference; 

CALL SET$RELATIVE$KEY; 

CALL vrits$from$memory; 
end; 

ELSE 

do; 

IF SER(CURRSNT$FLAG,2) THEN 

do; 

CALL SETi RANDOM^ POINTER? 

IF NOT INVALID THEN 

do; 

IF ( .3UFF$PTR+1)=HIGH$VAL0E THEN 

do; 
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rewrite$flag=true; 

CALL WRITE$FROM$MEMORY ; 

revrite$flag=false; 

end; 

ELSE 

CALL PRlNT$EaROR( 'W4'); 

end; 

ELSE 

call fatal Terror ( 'W3 ' ) ; 

end; 

end; 

CALL INC$PTR(9); 

end; 

/* 58: RWR */ 

do; 

CALL SET$I$0,* 

IF NOT SHR( CURRENT $F LAG ,2 ) THEN 
CALL FATAL$ERROR( 'W6') J 

rewrite$flag=true; 
call back$one$record; 

IF NOT INVALID TEEN CALL VfR ITE$?ROM$MEMOR Y J 

rewrite$flag=false; 

CALL INC5PTR(9); 

end; 

/* 59: DLR */ 

do; 

CALL SET$I$OJ 

IF NOT SHR(CURRENT$FLAG,2) THEN 
CALL FATAL$ERR0R('W6'); 

CALL SET$RANDOMi?OI NTER j 

rewrite$flag=true; 

IF NOT INVALID TEEN 

call vrite$empty$record; 
rewrite$flag=false; 

CALL IN C^PTR ( 9 ) J 

end; 

/* 60: MED */ 

do; 

CALL MOVE ( C$ADDR ( 3 ) , RES ( Ci ADDR ( 0) ) 

, C $ADDR ( 4 ) ) J 
BASE=RES( C$ ADDR( 1 ) ) ; 

HOLD=RES ( C$ ADDR ( 0 ) )5 
CTR=0; 

CTR1=0; 

DO WHILE (CTR<C$ADDR(2))AND(CTR 
< C$ ADDR ( 4 ) ) ; 

CALL CHECK$EDIT(H$3YTE(0)) J 

end; 
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IF CTR < C$ ADDR( 4 ) THEN 

CALL FILL(flOLD,C$ADDR(4)-CTR, ' 
CALL INC$PTR ( 10 ) J 

end; 

/* 61: MNE */ 

J /* NULL CASE */ 



/* 62: GDP */ 



do; 

DECLARE OFFSET BYTE; 

OFFS ET= CON VERT$TO$HEX ( C$ ADDR ( 1 ) , CiBYTE ( 1 ) -1 ) 
IF OFFSET > C$BYTE(0) + 1 THEN 

do; 

CALL PRI NT$ ERROR ( 'GD ' ) J 

CALL INC$PTR(SHL(C$BYTE(0) ,1) + 5); 

end; 

ELSE PROGRAM $COUNTER=C$ A DDR ( OFFSET +2); 

end; 

end; /* END OF CASS STATEMENT */ 

END; /* END OF DO FOREVER */ 

END execute; 

/#****# PROGRAM EXECUTION STARTS HERS * * * */ 

base=code$start; 

PROGRAM$COUNTER=B$ADDR ( 0) ; 

call execute; 
end; 
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READER 



do; 

/* COBOL COMPILER - PART 2 READER */ 

/* THIS PROGRAM IS LOADED IN WITH THE PART 1 PROGRAM 
AND IS CALLED WHEN PART 1 IS FINISHED. THIS PROGRAM 
OPENS THE PART2.COM FILE THAT CONTAINS THE CODS FOR 
PART 2 OF THE COMPILER, AND READS IT INTO CORE. AT 
THE END OF THE READ OPERATION, CONTROL IS PASSED TO 
THE SECOND PART PROGRAM. */ 



/* 3100H: LOAD POINT */ 

DECLARE 

START LITERALLY '100B', 

/* STARTING LOCATION FOR PART 2 */ 

ADR ADDRESS INITIAL( START ) , 

FCB (33) BYTE 

INITI AL( 0, 'PAPT2 COM' ,0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0,?, 0,0, 0,0, 0,0) 
INITI AL( 0, 'PART2 COM ' ,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0 
, 0 , 0 , 0 , 0,0 ,0 , 0 , 0 ) , 

I address; 

M0N1 : PROCEDURE! F, A) EXTERNAL; 

DECLARE ? 3YTE , A ADDRESS; 

END MONi; 



M0N2: PR0CEDUR3(F,A)3YTE EXTERNAL; 

DECLARE F BYTE, A ADDRESS; 

END M0N2,* 



BOOT: PROCEDURE EXTERNAL; 

end; 

OPEN: PROCEDURE (FCB) 3YTE ; 
DECLARE FCB ADDRESS; 
RETURN M0N2 (15, FCB)J 

end; 



READ: 



PROCEDURE ( ADDR ) BYTE; 
DECLARE ADDR ADDRESS; 
CALL MONI (26, ADDR); 
RETURN M0N2 (20, .FCB) 

end; 



/* SET DMA ADDRESS */ 
/* READ, AND RETURN 
ERROR CODE */ 



ERROR: PROCEDURE (CODE ) ; 

DECLARE CODE ADDRESS; 

CALL MONI (2, (HIGH (CODE) ) ) ; 
CALL MONI (2, (LOW(CODE) ) ) 5 
CALL TIME(10); 
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CALL eoot; 

end error; 

CALL MONl (26, 0100H); 

/* OPEN PASS2.COM */ 

IF OPEN ( . FCB ) = 255 THEN CALL ERR0R( '02 ' ) ; 

/* READ IN FILE */ 

I = 0100HJ /* INITIAL ADDRESS */ 

DO WHILE READ(I) = 0J /* READ 1 SECTOR */ 

1=1+ 0080HJ /* BUMP DMA ADDRESS */ 

end; 

CALL MONl (26, 0080H); /* RESET DMA ADDRESS */ 

CALL adr; 



end; 
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BUILD: 

do; 

/* NORMALLY ORG'ED AT 100H */ 

/* THIS PROGRAM TAKES THE CODE OUTPUT FROM THE COBOL 
COMPILER AND BUILDS THE ENVIRONMENT FOR THE COBOL 
INTERPRETER */ 



DECLARE 



LIT 


LITERALLY 


'LITERALLY ' , 


BOOT 


LIT 




3D0S 


LIT 


'5', 


TRUE 


LIT 


'1\ 


FALSE 


LIT 


'0', 


FOREVER 


LIT 


'WHILE TRUE' , 


FCB 


ADDRESS 


INITIAL (5CH ) , 


FCB$BYTS 


BASED FCB 


BYTE, 


FCB$BYTE$A 


BASED FCB (33) 


BYTE, 


I 


BYTE, 




ADDR 


ADDRESS 


INITIAL ( 100H ) , 


CHAR 


BASED ADDR 


BYTE, 


buff£ end 


LIT 


'100H ' , 


INTER P$FCB 


(33) BYTE 






INITIAL(0, CINTERP COM', 0,0, 


CODE$NOT $SET 


BYTE INITIAL (TRUE), 


RE ADER$ LOCATION LIT 


'1C80H ', 


INTERP$ ADDRESS 


ADDRESS 


INITIAL! 2000H ) , 


INTERP$CONTENT 


BASED 


INTEPP^ADDRESS ADDRESS, 


I$BYTE 


BASED 


INTERPSADDRESS (2) BYTE 


CODE$CTR 


ADDRESS , 




C^BYTE 


BASED 


CODE$ CTR BYTE, 


BASE 


ADDRESS, 




3$ ADDR 


BASED 


BASS ADDRESS, 


B^BYTE 


BASED 


BASE (4) BYTE; 



MON1 : PROCEDURE (F,A) EXTERNAL; 

DECLARE F BYTE, A ADDRESS; 
END MON1 ; 



M0N2: PROCEDURE (F,A) 
DECLARE F BYTE, A 
END M0N2J 



BYTE EXTERNAL? 
address; 



PRINTiCHAR: PROCEDURE! CHAR ) » 
DECLARE CHAR BYTE; 

CALL MONl ( 2, CHAR ) J 

END print$char; 



CRLF: PROCEDURE; 
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CALL PRINT$CHAR(13) J 
CALL PHI NT$CEAR( 10) ; 
END crlf; 



PRINT: PROCEDURE ( A ) J 
DECLARE A ADDRESS; 
CALL crle; 

CALL MON1 ( 9 , A ) > 

END print; 



OPEN: PROCEDURE (A) BYTE? 
DECLARE A ADDRESS; 
RETURN MON2 ( 1 5 , A ) ; 

END open; 

REBOOT: PROCEDURE; 

ADDR = boot; call addr; 
end reboot; 



MOVE: PROCEDURE( FROM , DEST, COUNT); 

DECLARE (FROM, DEST, COUNT) ADDRESS, 

(F BASED FROM, D BASED DEST) 3YTE J 
DO WHILE! COUNT : =COU NT-1 ) O0FFFFH; 

d=f; 

FROM=FROM+l ; 

DEST=DEST+l; 

end; 
end move; 



GETSCHAR: PROCEDURE BYTE; 

IF ( ADDR :=ADDR + 1)>=3UFF$END THEN 

do; 

IF MON2(20,FCB)<>0 THEN 

do; 

CALL PRINT! . ( 'END OF INPUT S')); 
CALL reboot; 

end; 

addr=s0h; 

end; 

RETURN CHAR? 

end oetSchar; 



NEXTSCHAR: PROCEDURE; 

char=get$char; 

END N EXT $ CHAR; 



STORE: PROCEDU RE (COUNT ) J 
DECLARE COUNT BYTE? 
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IF CODE$NOT$SET THEN 

do; 

CALL PRINT! .! 'CODS ERRORS')); 
CALL NEXTi CHAR J 

return; 

end; 

DO 1=1 TO count; 
c$byte=char; 
call next$char; 

CODE$CTR=CODE$CTR+i; 

end; 

end store; 



BACK$STUFF : PROCEDURE; 

DECLARE (HCLD, STUFF) ADDRESS; 
B ASS= .HOLD ; 

DO 1=0 TO 3; 

B$BYTE( I )=GET$CHAR; 

end; 

do forever; 

base=hold; 

hold=b$addr; 

b$addr=stuff; 

IF HOLD=0 THEN 

do; 

CALL N EXT$CHAR; 

return; 

end; 

end; 

end back$stuff; 



START$CODE: PROCEDURE; 

code$not$set=false; 

I$3YTE(0)=GET$CHAR» 
I$BYTE(l)=GETiCHAR; 
CCDE$CTR=INTERP$ CON TENT; 
CALL next^char; 
end start^code; 



GO$DEPENDI NO : PROCEDURE; 

CALL STORE (1 )J 

CALL STORE (SHL(CHAR ,1 ) + 4); 

end go$depending; 



INITIALIZE: PROCEDURE; 

DECLARE ( COUNT, WHERE, HO W$M ANY ) ADDRESS 
BASE*. WHERE? 

DO 1=0 TO 3; 

B$ BYTE! I )=GET$CHAR? 

end; 
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BA SF=WHERS - 1J 

DO COUNT = 1 TO HOW$MANYJ 

B$BYTE( COUNT )=GET$ CHAR; 

end; 

call next*cear; 
end initialize; 



BUILD: PROCEDURE; 



DECL 


ARE 




F2 


LIT 


'8 ' 


F3 


LIT 


'9' 


F4 


LIT 


'21 


F5 


LIT 


'24 


F6 


LIT 


'32 


F7 


LIT 


'39 


F9 


LIT 


'49 


F10 


LIT 


'54 


Fll 


LIT 


'60 


F13 


LIT 


'61 


GDP 


LIT 


'62 


INT 


LIT 


'63 


BST 


LIT 


'64 


TER 


LIT 


'65 


STP 


LIT 


'06 


SCD 


LIT 


'66 



do forever; 



IF CHAR 


< F2 


THEN 


CALL 


STORE ( 1 ) ; 


ELSE 


IF 


CHAR 


< 


F3 


THEN 


CALL ST0RS(2); 


ELSE 


IF 


CHAR 


< 


F4 


THEN 


CALL S TORE (3 ) ; 
CALL STOR E ( 4 ) ; 


ELSE 


IF 


CHAR 


< 


F5 


THEN 


ELSE 


IF 


CHAR 


< 


F6 


THEN 


CALL STORE ( 5 ) J 


ELSE 


I? 


CHAR 


< 


F7 


THEN 


CALL S TORE (6 ) J 


ELSE 


IF 


CHAR 


< 


?9 


THEN 


CALL STOR S ( 7 ) ; 


ELSE 


IF 


CHAR 


< 


FI 0 


THEN 


CALL STORE ( 9 ) J 


ELSE 


IF 


CHAR 


< 


Fll 


THEN 


CALL STOR E( 10) J 


ELSE 


IF 


CHAR 


< 


F 13 


THEN 


CALL STOREdl ) ; 


ELSE 


IF 


CHAR 


< 


GDP 


THEN 


CALL ST0RE(13); 


ELSE 


IF 


CHAR 


= 


GDP 


THEN 


call go*dspending; 


ELSE 


IF 


CHAR 




BST 


THEN 


CALL BACK$STUFF; 


ELSE 


IF 


CHAR 


= 


INT 


THEN 


call initialize; 


ELSE 


IF 


CHAR 


= 


TER 


THEN 





do; 

CS3YTE = ST?; 

CALL P?INT( .( 'LOAD FINISHED*')); 

RETURN ; 

end; 

ELSE IF CHAR = SCD TEEN CALL START*COEE; 

ELSE do; 

IF CHAR <> 0FEH THEN 

CALL PEINT( . ( 'LOAD ERROR*')); 
CALL next$char; 

end; 
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end; 

end build; 



/* PROGRAM EXECUTION STARTS HERE */ 

FCB$BYTE$A ( 32 ) ,FCB$B YTE=0 J 

CALL MCVE ( . ( 'CIN', 0,0,0 ,0) ,FCB + 9,7); 

IF OPEN ( FCB )=255 THEN 

do; 

CALL PRINT (.( 'FILE NOT FOUND $')); 

CALL reboot; 

end; 

call next$char; 
call build; 

CALL MOV E( . I NT ER Pi FCB, FCB , 33) ; 

FC B$BYTS$A ( 32 ) = 0; 

IF OPEN ( FCB ) =2 55 THEN 

do; 

CALL PRINT (. ( 'INTERPRETER NOT FOUND $')); 

call reboot; 

end; 

CALL MCVE( READERiLOCATION , 80H, 80H ) ; 

ADDR = 60E; CALL ADD?.; /* BRANCH TO 80H */ 

end; 
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INTRDR : 



/* NAME OF MODULE */ 



do; 

/* COBOL COMPILER - INTER? PEADER */ 

/* THIS PROGRAM IS CALLED BY THE EUILD PROGRAM AFTER 
CINTS3P.COM HAS BEEN OPENED, AND READS THE CODS INTO 
MEMORY */ 



/* 80E - LOAD POINT */ 

DECLARE 

START LITERALLY '100H', /* STARTING LOCATION FOR 

PART2 */ 

INTERP ADDRESS I N ITI AL ( START ) , 

I ADDRESS INITIAL (0080H); 

MONA: PROCEDURE ( F , A ) J 

DECLARE F BYTE, A ADDRESS,* 

L :G0 TO LJ /* PATCH TO -> ‘JMP BDOS ’ */ 

END mona; 

M0NB: PROCEDURE ( F , A ) BYTE; 

DECLARE F BYTE, A ADDRESS; 

L:GC TO L; /* PATCH TO -> "JMP BDCS'* */ 

RETURN 0J /* ZAP -> "N0-0?" */ 

END monb; 

DO WEILS i; 

CALL MONA (26, ( I : = I + 0080H ) ) J /* SET DMA ADDRESS */ 
IF MONB (20, 5CH) <> 0 THEN 

CALL INTER?; 

end; 

end; 
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DECODE : DOJ 



/* THIS PROGRAM TAKES THE CODE OUTPUT FPO M THE COBOL 
COMPILER AND CONVERTS IT INTO A READABLE OUTPUT TO 
FACILITATE DEBUGGING */ 



/* * * 100H : 



LOAD POINT */ 



DECLARE 



LIT 

BOOT 

BDOS 

FCB 

FCB$BYTE 

I 

AD DR 

BYTESCOUNT 

BYTESLOW 

BYTE$HI 

CHAR 

CSADDR 

BUFF$ END 

FILE^TYPE 



LITERALLY 

LIT 

LIT 

ADDRESS 
BASED FCB 
BYTE, 

ADDRESS 

ADDRESS 

BYTE, 



'LITERALLY ' , 

' 0 ', 

'5' . 

INITIAL ( 5CH ) , 
(1) BYTE, 

INITIAL ( 100H ) 
INITIAL (0), 



BYTE, 

B»SED A DDR BYTE, 

BASED ADDR ADDRESS, 

LIT '0FFE ' , 

(*) BYTE DATA ( ' C ' , ' I ' , ' N ' ) J 



f 



MO N 1 : PROCEDURE (F,A); 

DECLARE F BYTE, A ADDRESS; 

L: GO TO L? /* PATCH TO JM? 5 */ 

END MON1 J 



M0N2 : PROCEDURE ( F , A ) BYTE; 

DECLARE F BYTE, A ADDRESS; 

L:GO TO L; /* * * PATCH TO " JM? 5 " * * */ 

RETURN 0; 

END ^0N2; 



PRINTSCHAR: PROCEDURS(CHAR ) ; 
DECLARE CHAR BYTE; 

CALL MON1 ( 2 , CHAR ) J 

END printschar; 



CRLF : PROCEDURE; 

CALL PRINTSCHAR (13) J 
CALL ?RINT$CHAR(10) J 
END crlf; 



P: PROCEDURS(ADDl); 

DECLARE ADD1 ADDRESS, C 3ASED ADD1 (1) 3YTEJ 
CALL crlf; 

DO 1=0 TO 2; 
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CALL PPINT$CHAR( C( I ) ) ; 

end; 

CALL PRINT$CHAR( ' '); 

END PJ 

GET$CHAR : PROCEDURE 3YTE5 

IF ( ADDR :=ADDR + 1)>3UFF$END THEN 

do; 

IF MO N2 ( 20 t FCB )<>0 THEN 

do; 

CALL P( .( 'END') ) ; 

CALL TIME (10); 

L: GO TO L; /* PATCH TO "JM? 0000" */ 

end; 

addr=80h; 

end; 

RETURN CHARJ 

END get$char; 



D^CHAR: PROCEDURE ( OUTPUT $BYTE ) J 
DECLARE OUT?UT$BYTE BYTE; 

IF OUTPUT^ 3YTE<10 THEN 

CALL PRINT$CH AR(OUTPUT$BYTE + 30H); 

ELSE CALL PRI NT $ CHAR ( OUTPUTS BYTE + 37H ) ; 
END d$char; 



D: PROCEDURE (COUNT); 

declare(count ,j) address; 

DO J=1 TO count; 

CALL D$CEAR(SER(GET$CHAR,4) ) J 
CALL DiCHAR ( CEAR AND 0FH ) J 
CALL ?RINT$CHAR(' '); 

end; 
end d; 



PRINTiREST: PROCEDURE; 



DECLARE 




F2 


LIT 


'8', 


F3 


LIT 


'9', 


F4 


LIT 


'21 ', 


F5 


LIT 


'23' , 


F6 


LIT 


'32', 


F7 


LIT 


'39', 


F9 


LIT 


'49', 


F10 


LIT 


'54', 


Fll 


LIT 


'60' , 


F13 


LIT 


'61', 


GDP 


LIT 


'62', 


INT 


LIT 


'63', 


3ST 


LIT 


'64', 


TER 


LIT 


'65', 
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LIT 



66 '; 



s 



n T> 

o ^ 



IF CHAR < 
I? CHAR < 
IF CHAR < 
IF CHAR < 
IF CHAR < 
IF CHAR < 
IF CHAR < 
IF CHAR < 
IF CHAR < 



F2 


THEN 


return; 








F3 


THEN 


do; 


CALL 


D( i ) ; 


return ; 


end; 


F4 


THEN 


do; 


CALL 


D (2 ) ; 


return; 


end; 


F5 


THEN 


do; 


CALL 


D ( 3 ) ; 


return; 


end; 


F6 


THEN 


do; 


CALL 


D ( 4 ) ; 


return; 


end; 


F? 


THEN 


do; 


CALL 


d ( 5 ) ; 


return; 


end; 


F9 


THEN 


do; 


CALL 


D (6 ) ; 


return; 


end; 


F10 


THEN 


DC 


; CALL 


. DC 8 ) ; 


return 


; end; 


Fll 


THEN 


DO 


; CALL 


, d(9); 


return 


; end; 



IF CHAR < FI 3 THFN DO J CALL D(10); RETURN; END; 
IF CHAR < GrP THEN DO? CALL D ( 1 2 ) J RETURN*, END*, 
IF CHAP=GDP THEN DO J 

CALL D(l); CALL D ( S EL ( CH AR , 1 ) +5 ) ; RETURN; END; 

IF CHAR = INT THEN 
DO,* 



BYTE$COUNT = 0; 

CALL D(3); 

byte$low = char; 

CALL D(l); 

3YTE$HI = CHAR*, 

BYTE^COUNT = BYTE^HIJ 

BYTE$COUN T = SHL (BYT E$ COUNT ,8 ) + BYTEHOW; 
CALL D ( 3YTE$COUNT ) ; 

RETURN,* 



end; 

IF CHAR=BST THEN DO*, CALL 
IF CHAR=TER THEN DO,* CALL 
L: GO TO L; /* PATCH TO 
I? CHAR=SCD THEN DO J CALL 
IF CHAR <> 0FFH THEN CALL 
END ?RINT$RSST; 



DU); return; end; 
p( . ( 'end') ); 

’ JMP 0 * * */ 2ND; 

D(2); return; end; 

?( .('xxx')); 



/* PROGRAM EXECUTION STARTS HERS */ 

FCB$BYTE(32), FCB^3YTE(0) = 0? 

DO 1=0 TO 2J 

FC3SBYTS( I+9)=FILS$TY?E(I ) 5 

end; 

IF M0N2(15,FCB)=255 THEN DO ; CALL P(.('ZZZ')); 

L: GO TO LJ END; 

/* * * * PATCH TO " JMP BOOT" * * * */ 



DO WHILE I,* 

IF GET$CHAR <= 66 THEN DO CASE CHAR; 
J /* CASE 0 NOT USED */ 

CALL P( . ( 'ADD') ),* 

CALL ?(. ( 'SUB') ); 

CALL P( . ( 'MUL') ); 

CALL ?( . ( 'DI7') ); 

CALL P( . ( 'NEG') ); 
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CALL ?( . ( 'ST?') ) 
CALL P( . ( 'STI ') ) 
CALL P( . ( 'RND' ) ) 
CALL P( .( 'RET') ) 
CALL P( . ( 'CLS ' ) ) 
CALL P( . ( 'SEP/) ) 
CALL P( . ( 'BRN') ) 
CALL P(. ( 'OPN ' ) ) 
CALL P( . ( 'OP1') ) 
CALL P( . ( '0P2 ' ) ) 
CALL P( .( 'RGT ' ) ) 
CALL P( . ( 'RLT ' ) ) 
CALL P( . ( 'REQ') ) 
CALL P(. ( 'INV') ) 
CALL P( . ( 'EOR ' ) ) 
CALL ?( .( 'ACC') ) 
CALL P( . ( 'STD') ) 
CALL P( . ( 'LDI ') ) 
CALL P( . ( 'DIS') ) 
CALL P( . ( 'DEC') ) 
CALL P( . ( 'STO') ) 
CALL ?( . ( 'STI') ) 
CALL P( . ( 'ST2 ' ) ) 
CALL P( .( 'ST3') ) 
CALL P( . ( 'ST4 ' ) ) 
CALL P( . ( 'ST5 ' ) ) 
CALL P( . ( 'LOD') ) 
CALL ?( .( 'LDI') ) 
CALL P( . ( 'LD2 ' ) ) 
CALL P( . ( 'LD3 ') ) 
CALL P( . ( 'LD4 ' ) ) 
CALL P( . ( 'LD4 ' ) ) 
CALL ?( . ( 'LD6 ' ) ) 
CALL P( . ( 'PER') ) 
CALL P( . ( 'CNU ' ) ) 
CALL P(.( 'CN S') ) 
CALL P( .( 'CAL') ) 
CALL ?( . ( 'RWS ' ) ) 
CALL P( . ( 'DLS ' ) ) 
CALL P( .( 'RDE ' ) ) 
CALL P( . ( 'WTF ' ) ) 
CALL ?( . ( 'RVL' ) ) 
CALL ?( . ( 'VVL' ) ) 
CALL ? ( . ( 'SCR ' ) ) 
CALL P( . ( 'SOT ' ) ) 
CALL P( . ( 'SLT ') ) 
CALL P( .( 'SEQ') ) 
CALL P( . ( >07') ) 
CALL ?( . ( 'RRS ' ) ) 
CALL P( . ( 'WRS ') ) 
CALL P( . ( 'RRR ' ) ) 
CALL Pf . ( 'WRR' ) ) 
CALL P( . ( 'RWR ' ) ) 
CALL ?( . ( 'DLR ' ) ) 
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CALL P( . ( 'MED') )J 
CALL P( . ( 'MNE') ); 

CALL P ( . ( 'GDP') ); 

CALL P(.( 'I NT') ),* 

CALL P( . ( 'SST ' ) ); 

CALL P( . ( 'TER') )» 

CALL P ( . ( 'SCD ' ) )J 
END; /* OF CASE STATEMENT */ 
CALL print$rest; 
end; /* END OF DO VHILE */ 

end; 
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